libclass-methodmaker-perl 2.19-1 / usr / lib / perl5 / Class / MethodMaker / hash.pm

package Class::MethodMaker::hash;
use strict;
use warnings;

use AutoLoader 5.57  qw( AUTOLOAD );
our @ISA = qw( AutoLoader );

use Carp qw( carp croak cluck );

use constant DEBUG => $ENV{_CMM_DEBUG} ? 1 : 0;

__END__

=head1 NAME

Class::Method::hash - Create methods for handling a hash value.

=head1 SYNOPSIS

  use Class::MethodMaker
    [ hash => [qw/ x /] ];

  $instance->x;                 # empty
  $instance->x(a => 1, b => 2, c => 3);
  $instance->x_count == 3;      # true
  $instance->x = (b => 5, d => 8); # Note this *replaces* the hash,
                                   # not adds to it
  $instance->x_index('b') == 5; # true
  $instance->x_exists('c');     # false
  $instance->x_exists('d');     # true

=head1 DESCRIPTION

Creates methods to handle hash values in an object.  For a component named
C<x>, by default creates methods C<x>, C<x_reset>, C<x_clear>, C<x_isset>,
C<x_count>, C<x_index>, C<x_keys>, C<x_values>, C<x_each>, C<x_exists>,
C<x_delete>, C<x_set>, C<x_get>.


Methods available are:


=head3 C<*>

I<Created by default>.  This method returns the list of keys and values stored
in the slot (they are returned pairwise, i.e., key, value, key, value; as with
perl hashes, no order of keys is guaranteed).  If any arguments are provided
to this method, they B<replace> the current hash contents.  In an array
context it returns the keys, values as an array and in a scalar context as a
hash-reference.  Note that this reference is no longer a direct reference to
the storage, in contrast to Class::MethodMaker v1.  This is to protect
encapsulation.  See x_ref if you need that functionality (and are prepared to
take the associated risk.)

If a single argument is provided that is an arrayref or hashref, it is
expanded and its contents used in place of the existing contents.  This is a
more efficient passing mechanism for large numbers of values.


=head3 C<*_reset>

I<Created by default>.  Called without an argument, this resets the component
as a whole; deleting any associated storage, and returning the component to
its default state.  Normally, this means that I<*_isset> will return false,
and I<*> will return undef.  If C<-default> is in effect, then the component
will be set to the default value, and I<*_isset> will return true.  If
C<-default_ctor> is in effect, then the default subr will be invoked, and its
return value used to set the value of the component, and I<*_isset> will
return true.

If called with arguments, these arguments are treated as indexes into the
component, and the individual elements thus referenced are reset (their
storage deleted, so that I<*_isset(n)> will return false for appropriate I<n>,
except where C<-default> or C<-default_ctor> are in force, as above).  As with
perl arrays, resetting the highest set value implicitly decreases the count
(but x_reset(n) never unsets the aggregate itself, even if all the elements
are not set).


=head3 C<*_clear>

I<Created by default>.  Empty the component of all elements, but without
deleting the storage itself.

If given a list of keys, then the elements I<that exist> indexed by those keys
are set to undef (but not deleted).

Note the very different semantics: C<< $x->a_clear('b') >> sets the value of
C<b> in component 'a' to undef (if C<b>) already exists (so C<<
$x->a_isset('b')) >> returns true), but C<< $x->a_clear() >> deletes the
element C<b> from component 'a' (so C<< $x->a_isset('b')) >> returns false).


=head3 C<*_isset>

I<Created by default>.  Whether the component is currently set.  This is
different from being defined; initially, the component is not set (and if
read, will return undef); it can be set to undef (which is a set value, which
also returns undef).  Having been set, the only way to unset the component is
with C<*_reset>.

If a default value is in effect, then C<*_isset> will always return true.

I<*_isset()> tests the component as a whole.  I<*_isset(a)> tests the element
indexed by I<a>.  I<*_isset(a,b)> tests the elements indexed by I<a>, I<b>,
and returns the logical conjunction (I<and>) of the tests.


=head3 C<*_count>

I<Created by default>.  Returns the number of elements in this component.
This is not affected by presence (or lack) of a C<default> (or
C<default_ctor>).  Returns C<undef> if whole component not set (as per
I<*_isset>).


=head3 C<*_index>

I<Created by default>.  Takes a list of indices, returns a list of the
corresponding values.

If a default (or a default ctor) is in force, then a lookup by
index will vivify & set to the default the respective elements (and
therefore the aggregate data-structure also, if it's not already).


=head3 C<*_keys>

I<Created by default>.  The known keys, as a list in list context, as an
arrayref in scalar context.

If you're expecting a count of the keys in scalar context, see I<*_count>.


=head3 C<*_values>

I<Created by default>.  The known values, as a list in list context, as an
arrayref in scalar context.


=head3 C<*_each>

I<Created by default>.  The next pair of key, value (as a list) from the hash.


=head3 C<*_exists>

I<Created by default>.  Takes any number of arguments, considers each as a
key, and determines whether the key exists in the has.  Returns the logical
conjunction (I<and>).


=head3 C<*_delete>

I<Created by default>.  This operates exactly like I<*_reset>, except that
calling this with no args does nothing.  This is provided for orthogonality
with the Perl C<delete> operator, while I<*_reset> is provided for
orthogonality with other component types.


=head3 C<*_set>

  %n = $x->h; # (a=>1,b=>2,c=>3) (in some order)
  $h->h_set(b=>4,d=>7);
  %n = $h->a; # (a=>1,b=>4,c=>3,d=>7) (in some order)

I<Created by default>.  Takes a list, treated as pairs of index => value; each
given index is set to the corresponding value.  No return.

If two arguments are given, of which the first is an arrayref, then it is
treated as a list of indices of which the second argument (which must also be
an arrayref) are the corresponding values.  Thus the following two commands
are equivalent:

  $x->a_set(b=>4,d=>7);
  $x->a_set(['b','d'],[4,7]);


=head3 C<*_get>

I<Created by default>.  Retrieves the value of the component without setting
(ignores any arguments passed).

=cut


#------------------
# hash 

sub hash0000 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class

sub hash0010 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex

sub hash0100 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex

sub hash0110 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type

sub hash0002 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type

sub hash0012 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash static

sub hash0001 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - static

sub hash0011 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - static

sub hash0101 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - static

sub hash0111 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - static

sub hash0003 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - static

sub hash0013 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash default

sub hash0004 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - default

sub hash0014 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - default

sub hash0104 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - default

sub hash0114 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - default

sub hash0006 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - default

sub hash0016 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash static - default

sub hash0005 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - static - default

sub hash0015 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - static - default

sub hash0105 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - static - default

sub hash0115 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - static - default

sub hash0007 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - static - default

sub hash0017 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash v1_compat

sub hash0020 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - v1_compat

sub hash0030 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - v1_compat

sub hash0120 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - v1_compat

sub hash0130 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - v1_compat

sub hash0022 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - v1_compat

sub hash0032 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash static - v1_compat

sub hash0021 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - static - v1_compat

sub hash0031 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - static - v1_compat

sub hash0121 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - static - v1_compat

sub hash0131 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - static - v1_compat

sub hash0023 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - static - v1_compat

sub hash0033 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash default - v1_compat

sub hash0024 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - default - v1_compat

sub hash0034 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - default - v1_compat

sub hash0124 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - default - v1_compat

sub hash0134 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - default - v1_compat

sub hash0026 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - default - v1_compat

sub hash0036 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash static - default - v1_compat

sub hash0025 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - static - default - v1_compat

sub hash0035 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - static - default - v1_compat

sub hash0125 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - static - default - v1_compat

sub hash0135 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - static - default - v1_compat

sub hash0027 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - static - default - v1_compat

sub hash0037 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash default_ctor

sub hash0008 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - default_ctor

sub hash0018 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - default_ctor

sub hash0108 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - default_ctor

sub hash0118 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - default_ctor

sub hash000a {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - default_ctor

sub hash001a {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash static - default_ctor

sub hash0009 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - static - default_ctor

sub hash0019 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - static - default_ctor

sub hash0109 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - static - default_ctor

sub hash0119 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - static - default_ctor

sub hash000b {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - static - default_ctor

sub hash001b {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash v1_compat - default_ctor

sub hash0028 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - v1_compat - default_ctor

sub hash0038 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - v1_compat - default_ctor

sub hash0128 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - v1_compat - default_ctor

sub hash0138 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - v1_compat - default_ctor

sub hash002a {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - v1_compat - default_ctor

sub hash003a {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash static - v1_compat - default_ctor

sub hash0029 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - static - v1_compat - default_ctor

sub hash0039 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - static - v1_compat - default_ctor

sub hash0129 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - static - v1_compat - default_ctor

sub hash0139 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - static - v1_compat - default_ctor

sub hash002b {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - static - v1_compat - default_ctor

sub hash003b {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash store_cb

sub hash0080 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - store_cb

sub hash0090 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - store_cb

sub hash0180 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - store_cb

sub hash0190 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - store_cb

sub hash0082 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - store_cb

sub hash0092 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash static - store_cb

sub hash0081 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - static - store_cb

sub hash0091 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - static - store_cb

sub hash0181 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - static - store_cb

sub hash0191 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - static - store_cb

sub hash0083 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - static - store_cb

sub hash0093 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash default - store_cb

sub hash0084 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - default - store_cb

sub hash0094 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - default - store_cb

sub hash0184 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - default - store_cb

sub hash0194 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - default - store_cb

sub hash0086 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - default - store_cb

sub hash0096 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash static - default - store_cb

sub hash0085 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - static - default - store_cb

sub hash0095 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - static - default - store_cb

sub hash0185 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - static - default - store_cb

sub hash0195 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - static - default - store_cb

sub hash0087 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - static - default - store_cb

sub hash0097 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash v1_compat - store_cb

sub hash00a0 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - v1_compat - store_cb

sub hash00b0 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - v1_compat - store_cb

sub hash01a0 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - v1_compat - store_cb

sub hash01b0 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - v1_compat - store_cb

sub hash00a2 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - v1_compat - store_cb

sub hash00b2 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash static - v1_compat - store_cb

sub hash00a1 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - static - v1_compat - store_cb

sub hash00b1 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - static - v1_compat - store_cb

sub hash01a1 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - static - v1_compat - store_cb

sub hash01b1 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - static - v1_compat - store_cb

sub hash00a3 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - static - v1_compat - store_cb

sub hash00b3 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash default - v1_compat - store_cb

sub hash00a4 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - default - v1_compat - store_cb

sub hash00b4 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - default - v1_compat - store_cb

sub hash01a4 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - default - v1_compat - store_cb

sub hash01b4 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - default - v1_compat - store_cb

sub hash00a6 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - default - v1_compat - store_cb

sub hash00b6 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash static - default - v1_compat - store_cb

sub hash00a5 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - static - default - v1_compat - store_cb

sub hash00b5 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - static - default - v1_compat - store_cb

sub hash01a5 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - static - default - v1_compat - store_cb

sub hash01b5 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - static - default - v1_compat - store_cb

sub hash00a7 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - static - default - v1_compat - store_cb

sub hash00b7 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash default_ctor - store_cb

sub hash0088 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - default_ctor - store_cb

sub hash0098 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - default_ctor - store_cb

sub hash0188 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - default_ctor - store_cb

sub hash0198 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - default_ctor - store_cb

sub hash008a {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - default_ctor - store_cb

sub hash009a {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash static - default_ctor - store_cb

sub hash0089 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - static - default_ctor - store_cb

sub hash0099 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - static - default_ctor - store_cb

sub hash0189 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - static - default_ctor - store_cb

sub hash0199 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - static - default_ctor - store_cb

sub hash008b {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - static - default_ctor - store_cb

sub hash009b {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash v1_compat - default_ctor - store_cb

sub hash00a8 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - v1_compat - default_ctor - store_cb

sub hash00b8 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - v1_compat - default_ctor - store_cb

sub hash01a8 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - v1_compat - default_ctor - store_cb

sub hash01b8 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - v1_compat - default_ctor - store_cb

sub hash00aa {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - v1_compat - default_ctor - store_cb

sub hash00ba {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash static - v1_compat - default_ctor - store_cb

sub hash00a9 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - static - v1_compat - default_ctor - store_cb

sub hash00b9 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - static - v1_compat - default_ctor - store_cb

sub hash01a9 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - static - v1_compat - default_ctor - store_cb

sub hash01b9 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - static - v1_compat - default_ctor - store_cb

sub hash00ab {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - static - v1_compat - default_ctor - store_cb

sub hash00bb {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash read_cb

sub hash0040 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - read_cb

sub hash0050 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - read_cb

sub hash0140 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - read_cb

sub hash0150 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - read_cb

sub hash0042 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - read_cb

sub hash0052 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash static - read_cb

sub hash0041 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - static - read_cb

sub hash0051 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - static - read_cb

sub hash0141 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - static - read_cb

sub hash0151 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - static - read_cb

sub hash0043 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - static - read_cb

sub hash0053 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash default - read_cb

sub hash0044 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - default - read_cb

sub hash0054 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - default - read_cb

sub hash0144 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - default - read_cb

sub hash0154 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - default - read_cb

sub hash0046 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - default - read_cb

sub hash0056 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash static - default - read_cb

sub hash0045 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - static - default - read_cb

sub hash0055 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - static - default - read_cb

sub hash0145 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - static - default - read_cb

sub hash0155 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - static - default - read_cb

sub hash0047 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - static - default - read_cb

sub hash0057 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash v1_compat - read_cb

sub hash0060 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - v1_compat - read_cb

sub hash0070 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - v1_compat - read_cb

sub hash0160 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - v1_compat - read_cb

sub hash0170 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - v1_compat - read_cb

sub hash0062 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - v1_compat - read_cb

sub hash0072 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash static - v1_compat - read_cb

sub hash0061 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - static - v1_compat - read_cb

sub hash0071 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - static - v1_compat - read_cb

sub hash0161 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - static - v1_compat - read_cb

sub hash0171 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - static - v1_compat - read_cb

sub hash0063 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - static - v1_compat - read_cb

sub hash0073 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash default - v1_compat - read_cb

sub hash0064 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - default - v1_compat - read_cb

sub hash0074 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - default - v1_compat - read_cb

sub hash0164 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - default - v1_compat - read_cb

sub hash0174 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - default - v1_compat - read_cb

sub hash0066 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - default - v1_compat - read_cb

sub hash0076 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash static - default - v1_compat - read_cb

sub hash0065 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - static - default - v1_compat - read_cb

sub hash0075 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - static - default - v1_compat - read_cb

sub hash0165 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - static - default - v1_compat - read_cb

sub hash0175 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - static - default - v1_compat - read_cb

sub hash0067 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - static - default - v1_compat - read_cb

sub hash0077 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash default_ctor - read_cb

sub hash0048 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - default_ctor - read_cb

sub hash0058 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - default_ctor - read_cb

sub hash0148 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - default_ctor - read_cb

sub hash0158 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - default_ctor - read_cb

sub hash004a {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - default_ctor - read_cb

sub hash005a {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
                +{%{$_[0]->{$name}} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
                +{%{$_[0]->{$name}} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash static - default_ctor - read_cb

sub hash0049 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - static - default_ctor - read_cb

sub hash0059 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - static - default_ctor - read_cb

sub hash0149 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - static - default_ctor - read_cb

sub hash0159 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - static - default_ctor - read_cb

sub hash004b {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - static - default_ctor - read_cb

sub hash005b {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
                +{%{$store[0]} = %{$_[1]}};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
                +{%{$store[0]} = @_[1..$#_]};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash v1_compat - default_ctor - read_cb

sub hash0068 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - v1_compat - default_ctor - read_cb

sub hash0078 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - v1_compat - default_ctor - read_cb

sub hash0168 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - v1_compat - default_ctor - read_cb

sub hash0178 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - v1_compat - default_ctor - read_cb

sub hash006a {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - v1_compat - default_ctor - read_cb

sub hash007a {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %{$_[1]});
              } else {
  
                %{$_[0]->{$name}} = %{$_[1]};
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = @_[1..$#_]);
              } else {
  
                %{$_[0]->{$name}} = @_[1..$#_];
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash static - v1_compat - default_ctor - read_cb

sub hash0069 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - static - v1_compat - default_ctor - read_cb

sub hash0079 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - static - v1_compat - default_ctor - read_cb

sub hash0169 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - static - v1_compat - default_ctor - read_cb

sub hash0179 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - static - v1_compat - default_ctor - read_cb

sub hash006b {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - static - v1_compat - default_ctor - read_cb

sub hash007b {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
  
              # Only asgn-check the potential *values*
              for ( values %{$_[1]}) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %{$_[1]};
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %{$_[1]});
              } else {
  
                %{$store[0]} = %{$_[1]};
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
  
              # Only asgn-check the potential *values*
              for ( @_[map $_*2,1..($#_/2)]) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = @_[1..$#_];
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = @_[1..$#_]);
              } else {
  
                %{$store[0]} = @_[1..$#_];
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
  
               for (@{$_[2]}) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @{$_[2]};
             } else {
  
               for (@_[map {$_*2} 1..($#_/2)]) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} =  $_[$_*2]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash store_cb - read_cb

sub hash00c0 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - store_cb - read_cb

sub hash00d0 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - store_cb - read_cb

sub hash01c0 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - store_cb - read_cb

sub hash01d0 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - store_cb - read_cb

sub hash00c2 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - store_cb - read_cb

sub hash00d2 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash static - store_cb - read_cb

sub hash00c1 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - static - store_cb - read_cb

sub hash00d1 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - static - store_cb - read_cb

sub hash01c1 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - static - store_cb - read_cb

sub hash01d1 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - static - store_cb - read_cb

sub hash00c3 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - static - store_cb - read_cb

sub hash00d3 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash default - store_cb - read_cb

sub hash00c4 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - default - store_cb - read_cb

sub hash00d4 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - default - store_cb - read_cb

sub hash01c4 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - default - store_cb - read_cb

sub hash01d4 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - default - store_cb - read_cb

sub hash00c6 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - default - store_cb - read_cb

sub hash00d6 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash static - default - store_cb - read_cb

sub hash00c5 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - static - default - store_cb - read_cb

sub hash00d5 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - static - default - store_cb - read_cb

sub hash01c5 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - static - default - store_cb - read_cb

sub hash01d5 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - static - default - store_cb - read_cb

sub hash00c7 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - static - default - store_cb - read_cb

sub hash00d7 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash v1_compat - store_cb - read_cb

sub hash00e0 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - v1_compat - store_cb - read_cb

sub hash00f0 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - v1_compat - store_cb - read_cb

sub hash01e0 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - v1_compat - store_cb - read_cb

sub hash01f0 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - v1_compat - store_cb - read_cb

sub hash00e2 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - v1_compat - store_cb - read_cb

sub hash00f2 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash static - v1_compat - store_cb - read_cb

sub hash00e1 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - static - v1_compat - store_cb - read_cb

sub hash00f1 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - static - v1_compat - store_cb - read_cb

sub hash01e1 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - static - v1_compat - store_cb - read_cb

sub hash01f1 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - static - v1_compat - store_cb - read_cb

sub hash00e3 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - static - v1_compat - store_cb - read_cb

sub hash00f3 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash default - v1_compat - store_cb - read_cb

sub hash00e4 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - default - v1_compat - store_cb - read_cb

sub hash00f4 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - default - v1_compat - store_cb - read_cb

sub hash01e4 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - default - v1_compat - store_cb - read_cb

sub hash01f4 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - default - v1_compat - store_cb - read_cb

sub hash00e6 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - default - v1_compat - store_cb - read_cb

sub hash00f6 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash static - default - v1_compat - store_cb - read_cb

sub hash00e5 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - static - default - v1_compat - store_cb - read_cb

sub hash00f5 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - static - default - v1_compat - store_cb - read_cb

sub hash01e5 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - static - default - v1_compat - store_cb - read_cb

sub hash01f5 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - static - default - v1_compat - store_cb - read_cb

sub hash00e7 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - static - default - v1_compat - store_cb - read_cb

sub hash00f7 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash default_ctor - store_cb - read_cb

sub hash00c8 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - default_ctor - store_cb - read_cb

sub hash00d8 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - default_ctor - store_cb - read_cb

sub hash01c8 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - default_ctor - store_cb - read_cb

sub hash01d8 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - default_ctor - store_cb - read_cb

sub hash00ca {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - default_ctor - store_cb - read_cb

sub hash00da {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
                  +{%{$_[0]->{$name}}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
                +{%{$_[0]->{$name}} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash static - default_ctor - store_cb - read_cb

sub hash00c9 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - static - default_ctor - store_cb - read_cb

sub hash00d9 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - static - default_ctor - store_cb - read_cb

sub hash01c9 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - static - default_ctor - store_cb - read_cb

sub hash01d9 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - static - default_ctor - store_cb - read_cb

sub hash00cb {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - static - default_ctor - store_cb - read_cb

sub hash00db {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
                  +{%{$store[0]}};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
                $v = $_->($_[0], $v, $name, $old)
  
                  for @store_callbacks;
              } else {
                $v = $_->($_[0], $v, $name)
  
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
                +{%{$store[0]} = %$v};
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
                 $v = $_->($_[0], $v, $name, $old)
  
                   for @store_callbacks;
               } else {
                 $v = $_->($_[0], $v, $name)
  
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash v1_compat - default_ctor - store_cb - read_cb

sub hash00e8 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - v1_compat - default_ctor - store_cb - read_cb

sub hash00f8 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - v1_compat - default_ctor - store_cb - read_cb

sub hash01e8 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - v1_compat - default_ctor - store_cb - read_cb

sub hash01f8 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - v1_compat - default_ctor - store_cb - read_cb

sub hash00ea {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - v1_compat - default_ctor - store_cb - read_cb

sub hash00fa {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
       my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $_[0]->{$name} ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$_[0]->{$name}};
                } else {
  
                  $_[0]->{$name};
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $_[0]->{$name} ) {
                my $old = $_[0]->{$name};
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$_[0]->{$name}}, $tie_class, @tie_args
                unless exists $_[0]->{$name};
  
              if ( ! defined $want ) {
                %{$_[0]->{$name}} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$_[0]->{$name}} = %$v);
              } else {
  
                %{$_[0]->{$name}} = %$v;
                $_[0]->{$name};
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $_[0]->{$name} = +{}
                unless exists $_[0]->{$name};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$_[0]->{$name}} : $_[0]->{$name};
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$_[0]->{$name}};
  
              delete $_[0]->{$name};
            } else {
              delete @{$_[0]->{$name}}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$_[0]->{$name}} = ();
            } else {
              ${$_[0]->{$name}}{$_} = undef
                for grep exists ${$_[0]->{$name}}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $_[0]->{$name}
             } elsif ( @_ == 2 ) {
               exists $_[0]->{$name}->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $_[0]->{$name}->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $_[0]->{$name} ) {
               return scalar keys %{$_[0]->{$name}};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$_[0]->{$name}}, $tie_class, @tie_args
                   unless exists ($_[0]->{$name}->{$_});
                 if ( ! exists ($_[0]->{$name}->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$_[0]->{$name}}, $tie_class, @tie_args
                     unless exists $_[0]->{$name};
  
                   ($_[0]->{$name}->{$_}) = $default
                 }
  
               }
               @{$_[0]->{$name}}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$_[0]->{$name}}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$_[0]->{$name}}] : keys %{$_[0]->{$name}};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$_[0]->{$name}}] : values %{$_[0]->{$name}};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$_[0]->{$name}};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $_[0]->{$name}->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               @{$_[0]->{$name}}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $_[0]->{$name} ) {
                 my $old = $_[0]->{$name};
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$_[0]->{$name}}, $tie_class, @tie_args
                 unless exists $_[0]->{$name};
  
               ${$_[0]->{$name}}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $_[0]->{$name} },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash static - v1_compat - default_ctor - store_cb - read_cb

sub hash00e9 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - static - v1_compat - default_ctor - store_cb - read_cb

sub hash00f9 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash typex - static - v1_compat - default_ctor - store_cb - read_cb

sub hash01e9 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - typex - static - v1_compat - default_ctor - store_cb - read_cb

sub hash01f9 {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
              #   $_ += 0;
              #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
              #                "  : should be '%s' (or subclass thereof)\n",
              #                (defined($_)                                     ?
              #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
              #                 '*undef*'
              #                ), $typex))
              #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                   #   $_ += 0;
                   #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
                   #                "  : should be '%s' (or subclass thereof)\n",
                   #                (defined($_)                                     ?
                   #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                   #                 '*undef*'
                   #                ), $typex))
                   #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
               #   $_ += 0;
               #  croak(sprintf("Incorrect type for attribute $name: %s\n" .
               #                "  : should be '%s' (or subclass thereof)\n",
               #                (defined($_)                                     ?
               #                 (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
               #                 '*undef*'
               #                ), $typex))
               #    unless ! defined $_ or UNIVERSAL::isa($_, $typex);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash type - static - v1_compat - default_ctor - store_cb - read_cb

sub hash00eb {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------
# hash tie_class - type - static - v1_compat - default_ctor - store_cb - read_cb

sub hash00fb {
  my $class  = shift;
  my ($target_class, $name, $options, $global) = @_;
  
  my %known_options = map {; $_ => 1 } qw( static type forward
                                           default default_ctor
                                           tie_class tie_args
                                           read_cb store_cb
                                           v1_compat );
  if ( my @bad_opt = grep ! exists $known_options{$_}, keys %$options ) {
    my $prefix = 'Option' . (@bad_opt > 1 ? 's' : '');
    croak("$prefix not recognized for attribute type hash: ",
          join(', ', @bad_opt), "\n");
  }
  
  my $type = $options->{type};
  croak "argument to -type ($type) must be a simple value\n"
    unless ! ref $type;
  
  my $forward = $options->{forward};
  my @forward;
  if ( defined $forward ) {
    if ( ref $forward ) {
      croak("-forward option can only handle arrayrefs or simple values " .
            "($forward)\n")
        unless UNIVERSAL::isa($forward, 'ARRAY');
      @forward = @$forward;
      print "Value '$_' passed to -forward is not a simple value"
        for grep ref($_), @forward;
    } else {
      @forward = $forward;
    }
  }
  
  my ($default, $dctor, $default_defined);
  if ( exists $options->{default} ) {
    croak("Cannot specify both default & default_ctor options to hash ",
          "(attribute $name\n")
      if exists $options->{default_ctor};
    $default = $options->{default};
    $default_defined = 1;
  } elsif ( exists $options->{default_ctor} ) {
    if ( ! ref $options->{default_ctor} ) {
      my $meth = $options->{default_ctor};
      croak("default_ctor can only be a simple value when -type is in effect",
            " (attribute $name)\n")
        unless defined $type;
      croak("default_ctor must be a valid identifier (or a code ref): $meth ",
            "(attribute $name)\n")
        unless $meth =~ /^[A-Za-z_][A-Za-z0-9_]*/;
      $dctor = sub { $type->$meth(@_) };
    } else {
      $dctor = $options->{default_ctor};
      croak("Argument to default_ctor must be a simple value or a code ref ",
            " (attribute $name)\n")
        if ! UNIVERSAL::isa($dctor, 'CODE');
    }
    $default_defined = 1;
  }
  
  my ($tie_class, @tie_args);
  if ( exists $options->{tie_class} ) {
    $tie_class =  $options->{tie_class};
    if ( exists $options->{tie_args} ) {
      my $tie_args =  $options->{tie_args};
      @tie_args = ref $tie_args ? @$tie_args : $tie_args;
    }
  } elsif ( exists $options->{tie_args} ) {
    carp "tie_args option ignored in absence of tie_class(attribute $name)\n";
  }
  
  # callback options
  my @read_callbacks = ref $options->{read_cb} eq 'ARRAY' ?
                        @{$options->{read_cb}}            :
                        $options->{read_cb}
    if exists $options->{read_cb};
  my @store_callbacks = ref $options->{store_cb} eq 'ARRAY' ?
                        @{$options->{store_cb}}             :
                        $options->{store_cb}
  
    if exists $options->{store_cb};
  
  my @store;
  
  # Predefine keys for subs we always want to exist (because they're
  # referenced by other subs)
  my %names = map {; $_ => undef } qw( * *_set *_reset *_index *_each );
  # The newer '*' treats a single +{} differently.  This is needed to ensure
  # that hash_init works for v1 scenarios
  $names{'='} = '*_v1compat' if $options->{v1_compat};
  
  return {
  
  
  
          '*'        =>
          sub : method {
     my $z = \@_;   # work around stack problems
            my $want = wantarray;
            print STDERR "W: ", $want, ':', join(',',@_),"\n"
              if DEBUG;
            # We also deliberately avoid instantiating storage if not
            # necessary.
            if ( @_ == 1 ) {
              if ( exists $store[0] ) {
                return
                  unless defined $want;
                if ( $want ) {
                  %{$store[0]};
                } else {
  
                  $store[0];
                }
              } else {
                return
                  unless defined $want;
                if ( $want ) {
                  ();
                } else {
                  +{};
                }
              }
            } elsif ( @_ == 2 and ref $_[1] eq 'HASH') {
              my $v = +{%{$_[1]}};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            } else {
              croak "Uneven number of arguments to method '$names{'*'}'\n"
                unless @_ % 2;
  
              my $v = +{@_[1..$#_]};
              if ( exists $store[0] ) {
                my $old = $store[0];
  
                $v = $_->($_[0], $v, $name, $old, )
                  for @store_callbacks;
              } else {
  
                $v = $_->($_[0], $v, $name, undef, )
                  for @store_callbacks;
              }
  
              # Only asgn-check the potential *values*
              for (values %$v) {
                croak(sprintf("Incorrect type for attribute $name: %s\n" .
                              "  : should be '%s' (or subclass thereof)\n",
                              (defined($_)                                     ?
                               (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                               '*undef*'
                              ), $type))
                  unless ! defined $_ or UNIVERSAL::isa($_, $type);
              }
              tie %{$store[0]}, $tie_class, @tie_args
                unless exists $store[0];
  
              if ( ! defined $want ) {
                %{$store[0]} = %$v;
                return;
              }
  
              if ( $want ) {
                (%{$store[0]} = %$v);
              } else {
  
                %{$store[0]} = %$v;
                $store[0];
  
              }
            }
          },
  
          #
          # This method is for internal use only.  It exists only for v1
          # compatibility, and may change or go away at any time.  Caveat
          # Emptor.
          #
  
          '!*_v1compat' =>
          sub : method {
            my $want = wantarray;
  
            if ( @_ == 1 ) {
              # No args
              return
                unless defined $want;
              $store[0] = +{}
                unless exists $store[0];
              return $want ? %{$store[0]} : $store[0];
            } elsif ( @_ == 2 ) {
              # 1 arg
              if ( my $type = ref $_[1] ) {
                if ( $type eq 'ARRAY' ) {
                  my $x = $names{'*_index'};
                  return my @x = $_[0]->$x(@{$_[1]});
                } elsif ( $type eq 'HASH' ) {
                  my $x = $names{'*_set'};
                  $_[0]->$x(%{$_[1]});
                  return $want ? %{$store[0]} : $store[0];
                } else {
                  # Not a recognized ref type for hash method
                  # Assume it's an object type, for use with some tied hash
                  $x = $names{'*_index'};
                  return ($_[0]->$x($_[1]))[0];
                }
              } else { # $key is simple scalar
                $x = $names{'*_index'};
                return ($_[0]->$x($_[1]))[0];
              }
            } else {
              # Many args
              unless ( @_ % 2 ) {
                carp "No value for key '$_[-1]'.";
                push @_, undef;
              }
              my $x = $names{'*_set'};
              $_[0]->$x(@_[1..$#_]);
              $x = $names{'*'};
              return $want ? %{$store[0]} : $store[0];
            }
          },
  
  
          '*_reset'  =>
          sub : method {
            if ( @_ == 1 ) {
              untie %{$store[0]};
  
              delete $store[0];
            } else {
              delete @{$store[0]}{@_[1..$#_]};
            }
            return;
          },
  
  
          '*_clear'  =>
          sub : method {
            if ( @_ == 1 ) {
              %{$store[0]} = ();
            } else {
              ${$store[0]}{$_} = undef
                for grep exists ${$store[0]}{$_}, @_[1..$#_];
            }
            return;
          },
  
  
          '*_isset'  =>
          ( $default_defined      ?
            sub : method { 1 }    :
            sub : method {
              if ( @_ == 1 ) {
               exists $store[0]
             } elsif ( @_ == 2 ) {
               exists $store[0]->{$_[1]}
             } else {
               for ( @_[1..$#_] ) {
                 return
                   if ! exists $store[0]->{$_};
               }
               return 1;
             }
            }
          ),
  
  
           '*_count'  =>
           sub : method {
             if ( exists $store[0] ) {
               return scalar keys %{$store[0]};
             } else {
               return;
             }
           },
  
  
           # I did try to do clever things with returning refs if given refs,
           # but that conflicts with the use of lvalues
           '*_index' =>
           ( $default_defined      ?
             sub : method {
               for (@_[1..$#_]) {
                 tie %{$store[0]}, $tie_class, @tie_args
                   unless exists ($store[0]->{$_});
                 if ( ! exists ($store[0]->{$_}) ) {
                   my $default = $dctor->($_[0]);
                   for ($default) {
                     croak(sprintf("Incorrect type for attribute $name: %s\n" .
                                   "  : should be '%s' (or subclass thereof)\n",
                                   (defined($_)                                     ?
                                    (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                    '*undef*'
                                   ), $type))
                       unless ! defined $_ or UNIVERSAL::isa($_, $type);
                   }
                   tie %{$store[0]}, $tie_class, @tie_args
                     unless exists $store[0];
  
                   ($store[0]->{$_}) = $default
                 }
  
               }
               @{$store[0]}{@_[1..$#_]};
             }                     :
             sub : method {
               @{$store[0]}{@_[1..$#_]};
             }
           ),
  
  
           '*_keys' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return ! wantarray ? [keys %{$store[0]}] : keys %{$store[0]};
           },
  
  
           '*_values' =>
           sub : method {
             # Unusual ! wantarray order required because ?: supplies a scalar
             # context to it's middle argument.
             return
               ! wantarray ? [values %{$store[0]}] : values %{$store[0]};
           },
  
  
           '*_each' =>
           sub : method {
             return each %{$store[0]};
           },
  
  
           '*_exists' =>
           sub : method {
             return
               for grep ! exists  $store[0]->{$_}, @_[1..$#_];
             return 1;
           },
  
           '*_delete' =>
           sub : method {
             if ( @_ > 1 ) {
               my $x = $names{'*_reset'};
               $_[0]->$x(@_[1..$#_]);
             }
             return;
           },
  
  
  
           '*_set'   =>
           sub : method {
             croak
               sprintf("'%s' requires an even number of args (got %d)\n",
                       $names{'*_set'}, @_-1)
               unless @_ % 2;
             if ( @_ == 3 and ref $_[1] eq 'ARRAY' ) {
               my $v = [@{$_[2]}];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               @{$store[0]}{@{$_[1]}} = @$v;
             } else {
               my $v = [@_[map {$_*2} 1..($#_/2)]];
               if ( exists $store[0] ) {
                 my $old = $store[0];
  
                 $v = $_->($_[0], $v, $name, $old, )
                   for @store_callbacks;
               } else {
  
                 $v = $_->($_[0], $v, $name, undef, )
                   for @store_callbacks;
               }
  
               for (@$v) {
                 croak(sprintf("Incorrect type for attribute $name: %s\n" .
                               "  : should be '%s' (or subclass thereof)\n",
                               (defined($_)                                     ?
                                (ref($_) ? ref($_) : "plain value(-->$_<--)" )  :
                                '*undef*'
                               ), $type))
                   unless ! defined $_ or UNIVERSAL::isa($_, $type);
               }
               tie %{$store[0]}, $tie_class, @tie_args
                 unless exists $store[0];
  
               ${$store[0]}{$_[$_*2-1]} = $v->[$_-1]
                 for 1..($#_/2);
             }
             return;
           },
  
  
           '*_get'   =>
           sub : method {
             my $x = $names{'*'};
             return $_[0]->$x();
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_tally' =>
           sub : method {
             my @v;
             my ($y, $z) = @names{qw(*_set *_index)};
  
             for (@_[1..$#_]) {
               my $v = $_[0]->$z($_);
               $v++;
               $_[0]->$y($_, $v);
               push @v, $v;
             }
             return @v;
           },
  
           #
           # This method is deprecated.  It exists only for v1 compatibility,
           # and may change or go away at any time.  Caveat Emptor.
           #
  
           '!*_ref'   =>
           sub : method { $store[0] },
  
           map({; my $f = $_;
                $_ =>
                  sub : method {
                    my $x = $names{'*'};
                    my %y = $_[0]->$x();
                    while ( my($k, $v) = each %y ) {
                      $y{$k} = $v->$f(@_[1..$#_])
                        if defined $v;
                    }
                    # Unusual ! wantarray order required because ?: supplies
                    # a scalar context to it's middle argument.
                    ! wantarray ? \%y : %y;
                  }
               } @forward),
         }, \%names;
}

#------------------------------------

1; # keep require happy