Remove cpan/Object-Accessor

8 files changed, 0 insertions, 1363 deletions

diff --git a/cpan/Object-Accessor/lib/Object/Accessor.pm b/cpan/Object-Accessor/lib/Object/Accessor.pm
deleted file mode 100644
index 9a930905c2..0000000000
--- a/cpan/Object-Accessor/lib/Object/Accessor.pm
+++ /dev/null
@@ -1,818 +0,0 @@
-package Object::Accessor;
-use if $] > 5.017, 'deprecate';
-
-use strict;
-use Carp            qw[carp croak];
-use vars            qw[$FATAL $DEBUG $AUTOLOAD $VERSION];
-use Params::Check   qw[allow];
-
-### some objects might have overload enabled, we'll need to
-### disable string overloading for callbacks
-require overload;
-
-$VERSION    = '0.46';
-$FATAL      = 0;
-$DEBUG      = 0;
-
-use constant VALUE => 0;    # array index in the hash value
-use constant ALLOW => 1;    # array index in the hash value
-use constant ALIAS => 2;    # array index in the hash value
-
-=head1 NAME
-
-Object::Accessor - interface to create per object accessors
-
-=head1 SYNOPSIS
-
-    ### using the object
-    $obj = Object::Accessor->new;        # create object
-    $obj = Object::Accessor->new(@list); # create object with accessors
-    $obj = Object::Accessor->new(\%h);   # create object with accessors
-                                         # and their allow handlers
-
-    $bool   = $obj->mk_accessors('foo'); # create accessors
-    $bool   = $obj->mk_accessors(        # create accessors with input
-               {foo => ALLOW_HANDLER} ); # validation
-
-    $bool   = $obj->mk_aliases(          # create an alias to an existing
-                alias_name => 'method'); # method name
-
-    $clone  = $obj->mk_clone;            # create a clone of original
-                                         # object without data
-    $bool   = $obj->mk_flush;            # clean out all data
-
-    @list   = $obj->ls_accessors;        # retrieves a list of all
-                                         # accessors for this object
-
-    $bar    = $obj->foo('bar');          # set 'foo' to 'bar'
-    $bar    = $obj->foo();               # retrieve 'bar' again
-
-    $sub    = $obj->can('foo');          # retrieve coderef for
-                                         # 'foo' accessor
-    $bar    = $sub->('bar');             # set 'foo' via coderef
-    $bar    = $sub->();                  # retrieve 'bar' by coderef
-
-    ### using the object as base class
-    package My::Class;
-    use base 'Object::Accessor';
-
-    $obj    = My::Class->new;               # create base object
-    $bool   = $obj->mk_accessors('foo');    # create accessors, etc...
-
-    ### make all attempted access to non-existent accessors fatal
-    ### (defaults to false)
-    $Object::Accessor::FATAL = 1;
-
-    ### enable debugging
-    $Object::Accessor::DEBUG = 1;
-
-    ### advanced usage -- callbacks
-    {   my $obj = Object::Accessor->new('foo');
-        $obj->register_callback( sub { ... } );
-
-        $obj->foo( 1 ); # these calls invoke the callback you registered
-        $obj->foo()     # which allows you to change the get/set
-                        # behaviour and what is returned to the caller.
-    }
-
-    ### advanced usage -- lvalue attributes
-    {   my $obj = Object::Accessor::Lvalue->new('foo');
-        print $obj->foo = 1;            # will print 1
-    }
-
-    ### advanced usage -- scoped attribute values
-    {   my $obj = Object::Accessor->new('foo');
-
-        $obj->foo( 1 );
-        print $obj->foo;                # will print 1
-
-        ### bind the scope of the value of attribute 'foo'
-        ### to the scope of '$x' -- when $x goes out of
-        ### scope, 'foo's previous value will be restored
-        {   $obj->foo( 2 => \my $x );
-            print $obj->foo, ' ', $x;   # will print '2 2'
-        }
-        print $obj->foo;                # will print 1
-    }
-
-
-=head1 DESCRIPTION
-
-C<Object::Accessor> provides an interface to create per object
-accessors (as opposed to per C<Class> accessors, as, for example,
-C<Class::Accessor> provides).
-
-You can choose to either subclass this module, and thus using its
-accessors on your own module, or to store an C<Object::Accessor>
-object inside your own object, and access the accessors from there.
-See the C<SYNOPSIS> for examples.
-
-=head1 METHODS
-
-=head2 $object = Object::Accessor->new( [ARGS] );
-
-Creates a new (and empty) C<Object::Accessor> object. This method is
-inheritable.
-
-Any arguments given to C<new> are passed straight to C<mk_accessors>.
-
-If you want to be able to assign to your accessors as if they
-were C<lvalue>s, you should create your object in the
-C<Object::Accessor::Lvalue> namespace instead. See the section
-on C<LVALUE ACCESSORS> below.
-
-=cut
-
-sub new {
-    my $class   = shift;
-    my $obj     = bless {}, $class;
-
-    $obj->mk_accessors( @_ ) if @_;
-
-    return $obj;
-}
-
-=head2 $bool = $object->mk_accessors( @ACCESSORS | \%ACCESSOR_MAP );
-
-Creates a list of accessors for this object (and C<NOT> for other ones
-in the same class!).
-Will not clobber existing data, so if an accessor already exists,
-requesting to create again is effectively a C<no-op>.
-
-When providing a C<hashref> as argument, rather than a normal list,
-you can specify a list of key/value pairs of accessors and their
-respective input validators. The validators can be anything that
-C<Params::Check>'s C<allow> function accepts. Please see its manpage
-for details.
-
-For example:
-
-    $object->mk_accessors( {
-        foo     => qr/^\d+$/,       # digits only
-        bar     => [0,1],           # booleans
-        zot     => \&my_sub         # a custom verification sub
-    } );
-
-Returns true on success, false on failure.
-
-Accessors that are called on an object, that do not exist return
-C<undef> by default, but you can make this a fatal error by setting the
-global variable C<$FATAL> to true. See the section on C<GLOBAL
-VARIABLES> for details.
-
-Note that you can bind the values of attributes to a scope. This allows
-you to C<temporarily> change a value of an attribute, and have it's
-original value restored up on the end of it's bound variable's scope;
-
-For example, in this snippet of code, the attribute C<foo> will
-temporarily be set to C<2>, until the end of the scope of C<$x>, at
-which point the original value of C<1> will be restored.
-
-    my $obj = Object::Accessor->new;
-
-    $obj->mk_accessors('foo');
-    $obj->foo( 1 );
-    print $obj->foo;                # will print 1
-
-    ### bind the scope of the value of attribute 'foo'
-    ### to the scope of '$x' -- when $x goes out of
-    ### scope, 'foo' previous value will be restored
-    {   $obj->foo( 2 => \my $x );
-        print $obj->foo, ' ', $x;   # will print '2 2'
-    }
-    print $obj->foo;                # will print 1
-
-
-Note that all accessors are read/write for everyone. See the C<TODO>
-section for details.
-
-=cut
-
-sub mk_accessors {
-    my $self    = $_[0];
-    my $is_hash = UNIVERSAL::isa( $_[1], 'HASH' );
-
-    ### first argument is a hashref, which means key/val pairs
-    ### as keys + allow handlers
-    for my $acc ( $is_hash ? keys %{$_[1]} : @_[1..$#_] ) {
-
-        ### already created apparently
-        if( exists $self->{$acc} ) {
-            __PACKAGE__->___debug( "Accessor '$acc' already exists");
-            next;
-        }
-
-        __PACKAGE__->___debug( "Creating accessor '$acc'");
-
-        ### explicitly vivify it, so that exists works in ls_accessors()
-        $self->{$acc}->[VALUE] = undef;
-
-        ### set the allow handler only if one was specified
-        $self->{$acc}->[ALLOW] = $_[1]->{$acc} if $is_hash;
-    }
-
-    return 1;
-}
-
-=head2 @list = $self->ls_accessors;
-
-Returns a list of accessors that are supported by the current object.
-The corresponding coderefs can be retrieved by passing this list one
-by one to the C<can> method.
-
-=cut
-
-sub ls_accessors {
-    ### metainformation is stored in the stringified
-    ### key of the object, so skip that when listing accessors
-    return sort grep { $_ ne "$_[0]" } keys %{$_[0]};
-}
-
-=head2 $ref = $self->ls_allow(KEY)
-
-Returns the allow handler for the given key, which can be used with
-C<Params::Check>'s C<allow()> handler. If there was no allow handler
-specified, an allow handler that always returns true will be returned.
-
-=cut
-
-sub ls_allow {
-    my $self = shift;
-    my $key  = shift or return;
-    return exists $self->{$key}->[ALLOW]
-                ? $self->{$key}->[ALLOW]
-                : sub { 1 };
-}
-
-=head2 $bool = $self->mk_aliases( alias => method, [alias2 => method2, ...] );
-
-Creates an alias for a given method name. For all intents and purposes,
-these two accessors are now identical for this object. This is akin to
-doing the following on the symbol table level:
-
-  *alias = *method
-
-This allows you to do the following:
-
-  $self->mk_accessors('foo');
-  $self->mk_aliases( bar => 'foo' );
-
-  $self->bar( 42 );
-  print $self->foo;     # will print 42
-
-=cut
-
-sub mk_aliases {
-    my $self    = shift;
-    my %aliases = @_;
-
-    while( my($alias, $method) = each %aliases ) {
-
-        ### already created apparently
-        if( exists $self->{$alias} ) {
-            __PACKAGE__->___debug( "Accessor '$alias' already exists");
-            next;
-        }
-
-        $self->___alias( $alias => $method );
-    }
-
-    return 1;
-}
-
-=head2 $clone = $self->mk_clone;
-
-Makes a clone of the current object, which will have the exact same
-accessors as the current object, but without the data stored in them.
-
-=cut
-
-### XXX this creates an object WITH allow handlers at all times.
-### even if the original didnt
-sub mk_clone {
-    my $self    = $_[0];
-    my $class   = ref $self;
-
-    my $clone   = $class->new;
-
-    ### split out accessors with and without allow handlers, so we
-    ### don't install dummy allow handers (which makes O::A::lvalue
-    ### warn for example)
-    my %hash; my @list;
-    for my $acc ( $self->ls_accessors ) {
-        my $allow = $self->{$acc}->[ALLOW];
-        $allow ? $hash{$acc} = $allow : push @list, $acc;
-
-        ### is this an alias?
-        if( my $org = $self->{ $acc }->[ ALIAS ] ) {
-            $clone->___alias( $acc => $org );
-        }
-    }
-
-    ### copy the accessors from $self to $clone
-    $clone->mk_accessors( \%hash ) if %hash;
-    $clone->mk_accessors( @list  ) if @list;
-
-    ### copy callbacks
-    #$clone->{"$clone"} = $self->{"$self"} if $self->{"$self"};
-    $clone->___callback( $self->___callback );
-
-    return $clone;
-}
-
-=head2 $bool = $self->mk_flush;
-
-Flushes all the data from the current object; all accessors will be
-set back to their default state of C<undef>.
-
-Returns true on success and false on failure.
-
-=cut
-
-sub mk_flush {
-    my $self = $_[0];
-
-    # set each accessor's data to undef
-    $self->{$_}->[VALUE] = undef for $self->ls_accessors;
-
-    return 1;
-}
-
-=head2 $bool = $self->mk_verify;
-
-Checks if all values in the current object are in accordance with their
-own allow handler. Specifically useful to check if an empty initialised
-object has been filled with values satisfying their own allow criteria.
-
-=cut
-
-sub mk_verify {
-    my $self = $_[0];
-
-    my $fail;
-    for my $name ( $self->ls_accessors ) {
-        unless( allow( $self->$name, $self->ls_allow( $name ) ) ) {
-            my $val = defined $self->$name ? $self->$name : '<undef>';
-
-            __PACKAGE__->___error("'$name' ($val) is invalid");
-            $fail++;
-        }
-    }
-
-    return if $fail;
-    return 1;
-}
-
-=head2 $bool = $self->register_callback( sub { ... } );
-
-This method allows you to register a callback, that is invoked
-every time an accessor is called. This allows you to munge input
-data, access external data stores, etc.
-
-You are free to return whatever you wish. On a C<set> call, the
-data is even stored in the object.
-
-Below is an example of the use of a callback.
-
-    $object->some_method( "some_value" );
-
-    my $callback = sub {
-        my $self    = shift; # the object
-        my $meth    = shift; # "some_method"
-        my $val     = shift; # ["some_value"]
-                             # could be undef -- check 'exists';
-                             # if scalar @$val is empty, it was a 'get'
-
-        # your code here
-
-        return $new_val;     # the value you want to be set/returned
-    }
-
-To access the values stored in the object, circumventing the
-callback structure, you should use the C<___get> and C<___set> methods
-documented further down.
-
-=cut
-
-sub register_callback {
-    my $self    = shift;
-    my $sub     = shift or return;
-
-    ### use the memory address as key, it's not used EVER as an
-    ### accessor --kane
-    $self->___callback( $sub );
-
-    return 1;
-}
-
-
-=head2 $bool = $self->can( METHOD_NAME )
-
-This method overrides C<UNIVERAL::can> in order to provide coderefs to
-accessors which are loaded on demand. It will behave just like
-C<UNIVERSAL::can> where it can -- returning a class method if it exists,
-or a closure pointing to a valid accessor of this particular object.
-
-You can use it as follows:
-
-    $sub = $object->can('some_accessor');   # retrieve the coderef
-    $sub->('foo');                          # 'some_accessor' now set
-                                            # to 'foo' for $object
-    $foo = $sub->();                        # retrieve the contents
-                                            # of 'some_accessor'
-
-See the C<SYNOPSIS> for more examples.
-
-=cut
-
-### custom 'can' as UNIVERSAL::can ignores autoload
-sub can {
-    my($self, $method) = @_;
-
-    ### it's one of our regular methods
-    my $code = $self->UNIVERSAL::can($method);
-    if( $code ) {
-        carp( "Can '$method' -- provided by package" ) if $DEBUG;
-        return $code;
-    }
-
-    ### it's an accessor we provide;
-    if( UNIVERSAL::isa( $self, 'HASH' ) and exists $self->{$method} ) {
-        carp( "Can '$method' -- provided by object" ) if $DEBUG;
-        return sub { $self->$method(@_); }
-    }
-
-    ### we don't support it
-    carp( "Cannot '$method'" ) if $DEBUG;
-    return;
-}
-
-### don't autoload this
-sub DESTROY { 1 };
-
-### use autoload so we can have per-object accessors,
-### not per class, as that is incorrect
-sub AUTOLOAD {
-    my $self    = shift;
-    my($method) = ($AUTOLOAD =~ /([^:']+$)/);
-
-    my $val = $self->___autoload( $method, @_ ) or return;
-
-    return $val->[0];
-}
-
-sub ___autoload {
-    my $self    = shift;
-    my $method  = shift;
-    my $assign  = scalar @_;    # is this an assignment?
-
-    ### a method on our object
-    if( UNIVERSAL::isa( $self, 'HASH' ) ) {
-        if ( not exists $self->{$method} ) {
-            __PACKAGE__->___error("No such accessor '$method'", 1);
-            return;
-        }
-
-    ### a method on something else, die with a descriptive error;
-    } else {
-        local $FATAL = 1;
-        __PACKAGE__->___error(
-                "You called '$AUTOLOAD' on '$self' which was interpreted by ".
-                __PACKAGE__ . " as an object call. Did you mean to include ".
-                "'$method' from somewhere else?", 1 );
-    }
-
-    ### is this is an alias, redispatch to the original method
-    if( my $original = $self->{ $method }->[ALIAS] ) {
-        return $self->___autoload( $original, @_ );
-    }
-
-    ### assign?
-    my $val = $assign ? shift(@_) : $self->___get( $method );
-
-    if( $assign ) {
-
-        ### any binding?
-        if( $_[0] ) {
-            if( ref $_[0] and UNIVERSAL::isa( $_[0], 'SCALAR' ) ) {
-
-                ### tie the reference, so we get an object and
-                ### we can use it's going out of scope to restore
-                ### the old value
-                my $cur = $self->{$method}->[VALUE];
-
-                tie ${$_[0]}, __PACKAGE__ . '::TIE',
-                        sub { $self->$method( $cur ) };
-
-                ${$_[0]} = $val;
-
-            } else {
-                __PACKAGE__->___error(
-                    "Can not bind '$method' to anything but a SCALAR", 1
-                );
-            }
-        }
-
-        ### need to check the value?
-        if( defined $self->{$method}->[ALLOW] ) {
-
-            ### double assignment due to 'used only once' warnings
-            local $Params::Check::VERBOSE = 0;
-            local $Params::Check::VERBOSE = 0;
-
-            allow( $val, $self->{$method}->[ALLOW] ) or (
-                __PACKAGE__->___error(
-                    "'$val' is an invalid value for '$method'", 1),
-                return
-            );
-        }
-    }
-
-    ### callbacks?
-    if( my $sub = $self->___callback ) {
-        $val = eval { $sub->( $self, $method, ($assign ? [$val] : []) ) };
-
-        ### register the error
-        $self->___error( $@, 1 ), return if $@;
-    }
-
-    ### now we can actually assign it
-    if( $assign ) {
-        $self->___set( $method, $val ) or return;
-    }
-
-    return [$val];
-}
-
-=head2 $val = $self->___get( METHOD_NAME );
-
-Method to directly access the value of the given accessor in the
-object. It circumvents all calls to allow checks, callbacks, etc.
-
-Use only if you C<Know What You Are Doing>! General usage for
-this functionality would be in your own custom callbacks.
-
-=cut
-
-### XXX O::A::lvalue is mirroring this behaviour! if this
-### changes, lvalue's autoload must be changed as well
-sub ___get {
-    my $self    = shift;
-    my $method  = shift or return;
-    return $self->{$method}->[VALUE];
-}
-
-=head2 $bool = $self->___set( METHOD_NAME => VALUE );
-
-Method to directly set the value of the given accessor in the
-object. It circumvents all calls to allow checks, callbacks, etc.
-
-Use only if you C<Know What You Are Doing>! General usage for
-this functionality would be in your own custom callbacks.
-
-=cut
-
-sub ___set {
-    my $self    = shift;
-    my $method  = shift or return;
-
-    ### you didn't give us a value to set!
-    @_ or return;
-    my $val     = shift;
-
-    ### if there's more arguments than $self, then
-    ### replace the method called by the accessor.
-    ### XXX implement rw vs ro accessors!
-    $self->{$method}->[VALUE] = $val;
-
-    return 1;
-}
-
-=head2 $bool = $self->___alias( ALIAS => METHOD );
-
-Method to directly alias one accessor to another for
-this object. It circumvents all sanity checks, etc.
-
-Use only if you C<Know What You Are Doing>!
-
-=cut
-
-sub ___alias {
-    my $self    = shift;
-    my $alias   = shift or return;
-    my $method  = shift or return;
-
-    $self->{ $alias }->[ALIAS] = $method;
-
-    return 1;
-}
-
-sub ___debug {
-    return unless $DEBUG;
-
-    my $self = shift;
-    my $msg  = shift;
-
-    local $Carp::CarpLevel += 1;
-
-    carp($msg);
-}
-
-sub ___error {
-    my $self = shift;
-    my $msg  = shift;
-    my $lvl  = shift || 0;
-    local $Carp::CarpLevel += ($lvl + 1);
-    $FATAL ? croak($msg) : carp($msg);
-}
-
-### objects might be overloaded.. if so, we can't trust what "$self"
-### will return, which might get *really* painful.. so check for that
-### and get their unoverloaded stringval if needed.
-sub ___callback {
-    my $self = shift;
-    my $sub  = shift;
-
-    my $mem  = overload::Overloaded( $self )
-                ? overload::StrVal( $self )
-                : "$self";
-
-    $self->{$mem} = $sub if $sub;
-
-    return $self->{$mem};
-}
-
-=head1 LVALUE ACCESSORS
-
-C<Object::Accessor> supports C<lvalue> attributes as well. To enable
-these, you should create your objects in the designated namespace,
-C<Object::Accessor::Lvalue>. For example:
-
-    my $obj = Object::Accessor::Lvalue->new('foo');
-    $obj->foo += 1;
-    print $obj->foo;
-
-will actually print C<1> and work as expected. Since this is an
-optional feature, that's not desirable in all cases, we require
-you to explicitly use the C<Object::Accessor::Lvalue> class.
-
-Doing the same on the standard C<Object>>Accessor> class would
-generate the following code & errors:
-
-    my $obj = Object::Accessor->new('foo');
-    $obj->foo += 1;
-
-    Can't modify non-lvalue subroutine call
-
-Note that C<lvalue> support on C<AUTOLOAD> routines is a
-C<perl 5.8.x> feature. See perldoc L<perl58delta> for details.
-
-=head2 CAVEATS
-
-=over 4
-
-=item * Allow handlers
-
-Due to the nature of C<lvalue subs>, we never get access to the
-value you are assigning, so we can not check it against your allow
-handler. Allow handlers are therefor unsupported under C<lvalue>
-conditions.
-
-See C<perldoc perlsub> for details.
-
-=item * Callbacks
-
-Due to the nature of C<lvalue subs>, we never get access to the
-value you are assigning, so we can not check provide this value
-to your callback. Furthermore, we can not distinguish between
-a C<get> and a C<set> call. Callbacks are therefor unsupported
-under C<lvalue> conditions.
-
-See C<perldoc perlsub> for details.
-
-
-=cut
-
-{   package Object::Accessor::Lvalue;
-    use base 'Object::Accessor';
-    use strict;
-    use vars qw[$AUTOLOAD];
-
-    ### constants needed to access values from the objects
-    *VALUE = *Object::Accessor::VALUE;
-    *ALLOW = *Object::Accessor::ALLOW;
-
-    ### largely copied from O::A::Autoload
-    sub AUTOLOAD : lvalue {
-        my $self    = shift;
-        my($method) = ($AUTOLOAD =~ /([^:']+$)/);
-
-        $self->___autoload( $method, @_ ) or return;
-
-        ### *dont* add return to it, or it won't be stored
-        ### see perldoc perlsub on lvalue subs
-        ### XXX can't use $self->___get( ... ), as we MUST have
-        ### the container that's used for the lvalue assign as
-        ### the last statement... :(
-        $self->{$method}->[ VALUE() ];
-    }
-
-    sub mk_accessors {
-        my $self    = shift;
-        my $is_hash = UNIVERSAL::isa( $_[0], 'HASH' );
-
-        $self->___error(
-            "Allow handlers are not supported for '". __PACKAGE__ ."' objects"
-        ) if $is_hash;
-
-        return $self->SUPER::mk_accessors( @_ );
-    }
-
-    sub register_callback {
-        my $self = shift;
-        $self->___error(
-            "Callbacks are not supported for '". __PACKAGE__ ."' objects"
-        );
-        return;
-    }
-}
-
-
-### standard tie class for bound attributes
-{   package Object::Accessor::TIE;
-    use Tie::Scalar;
-    use base 'Tie::StdScalar';
-
-    my %local = ();
-
-    sub TIESCALAR {
-        my $class   = shift;
-        my $sub     = shift;
-        my $ref     = undef;
-        my $obj     =  bless \$ref, $class;
-
-        ### store the restore sub
-        $local{ $obj } = $sub;
-        return $obj;
-    }
-
-    sub DESTROY {
-        my $tied    = shift;
-        my $sub     = delete $local{ $tied };
-
-        ### run the restore sub to set the old value back
-        return $sub->();
-    }
-}
-
-=back
-
-=head1 GLOBAL VARIABLES
-
-=head2 $Object::Accessor::FATAL
-
-Set this variable to true to make all attempted access to non-existent
-accessors be fatal.
-This defaults to C<false>.
-
-=head2 $Object::Accessor::DEBUG
-
-Set this variable to enable debugging output.
-This defaults to C<false>.
-
-=head1 TODO
-
-=head2 Create read-only accessors
-
-Currently all accessors are read/write for everyone. Perhaps a future
-release should make it possible to have read-only accessors as well.
-
-=head1 CAVEATS
-
-If you use codereferences for your allow handlers, you will not be able
-to freeze the data structures using C<Storable>.
-
-Due to a bug in storable (until at least version 2.15), C<qr//> compiled
-regexes also don't de-serialize properly. Although this bug has been
-reported, you should be aware of this issue when serializing your objects.
-
-You can track the bug here:
-
-    http://rt.cpan.org/Ticket/Display.html?id=1827
-
-=head1 BUG REPORTS
-
-Please report bugs or other issues to E<lt>bug-object-accessor@rt.cpan.orgE<gt>.
-
-=head1 AUTHOR
-
-This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
-
-=head1 COPYRIGHT
-
-This library is free software; you may redistribute and/or modify it
-under the same terms as Perl itself.
-
-=cut
-
-1;
diff --git a/cpan/Object-Accessor/t/00_Object-Accessor.t b/cpan/Object-Accessor/t/00_Object-Accessor.t
deleted file mode 100644
index bc207c24e3..0000000000
--- a/cpan/Object-Accessor/t/00_Object-Accessor.t
+++ /dev/null
@@ -1,127 +0,0 @@
- BEGIN { chdir 't' if -d 't' };
-
-use strict;
-use lib '../lib';
-use Test::More 'no_plan';
-use Data::Dumper;
-
-my $Class = 'Object::Accessor';
-
-use_ok($Class);
-
-my $Object  = $Class->new;
-my $Acc     = 'foo';
-my $Err_re  = qr/No such accessor '$Acc'/;
-
-### stupid warnings
-### XXX this will break warning tests though if enabled
-$Object::Accessor::DEBUG = $Object::Accessor::DEBUG = 1 if @ARGV;
-
-
-### check the object
-{   ok( $Object,                "Object of '$Class' created" );
-    isa_ok( $Object,            $Class );
-}
-
-### check non existent accessor
-{   my $warning;
-    local $SIG{__WARN__} = sub { $warning .= "@_" };
-
-    ok(!$Object->can($Acc),     "Cannot '$Acc'" );
-    ok(!$Object->$Acc(),        "   Method '$Acc' returns false" );
-    like( $warning, $Err_re,    "   Warning logged" );
-
-    ### check fatal error
-    {   local $Object::Accessor::FATAL = 1;
-        local $Object::Accessor::FATAL = 1; # stupid warnings
-
-        my $rv = eval { $Object->$Acc() };
-
-        ok( $@,                 "Cannot '$Acc' -- dies" );
-        ok(!$rv,                "   Method '$Acc' returns false" );
-        like( $@, $Err_re,      "   Fatal error logged" );
-    }
-}
-
-### create an accessor;
-{   my $warning;
-    local $SIG{__WARN__} = sub { $warning .= "@_" };
-
-    ok( $Object->mk_accessors( $Acc ),
-                                "Accessor '$Acc' created" );
-
-    ok( $Object->can( $Acc ),   "   Can '$Acc'" );
-    ok(!$warning,               "   No warnings logged" );
-}
-
-### try to use the accessor
-{   for my $var ($0, $$) {
-
-        ok( $Object->$Acc( $var ),  "'$Acc' set to '$var'" );
-        is( $Object->$Acc(), $var,  "   '$Acc' still holds '$var'" );
-
-        my $sub = $Object->can( $Acc );
-        ok( $sub,                   "Retrieved '$Acc' coderef" );
-        isa_ok( $sub,               "CODE" );
-        is( $sub->(), $var,         "   '$Acc' via coderef holds '$var'" );
-
-        ok( $sub->(1),              "   '$Acc' set via coderef to '1'" );
-        is( $Object->$Acc(), 1,     "   '$Acc' still holds '1'" );
-    }
-}
-
-### get a list of accessors
-{   my @list = $Object->ls_accessors;
-    ok( scalar(@list),              "Accessors retrieved" );
-
-    for my $acc ( @list ) {
-        ok( $Object->can( $acc ),   "   Accessor '$acc' is valid" );
-    }
-
-    is_deeply( \@list, [$Acc],      "   Only expected accessors found" );
-}
-
-### clone the original
-{   my $clone = $Object->mk_clone;
-    my @list  = $clone->ls_accessors;
-
-    ok( $clone,                     "Clone created" );
-    isa_ok( $clone,                 $Class );
-    ok( scalar(@list),              "   Clone has accessors" );
-    is_deeply( \@list, [$Object->ls_accessors],
-                                    "   Only expected accessors found" );
-
-    for my $acc ( @list ) {
-        ok( !defined( $clone->$acc() ),
-                                    "   Accessor '$acc' is empty" );
-    }
-}
-
-### flush the original values
-{   my $val = $Object->$Acc();
-    ok( $val,                       "Objects '$Acc' has a value" );
-
-    ok( $Object->mk_flush,          "   Object flushed" );
-    ok( !$Object->$Acc(),           "   Objects '$Acc' is now empty" );
-}
-
-### check that only our original object can do '$Acc'
-{   my $warning;
-    local $SIG{__WARN__} = sub { $warning .= "@_" };
-
-    my $other = $Class->new;
-
-
-    ok(!$other->can($Acc),          "Cannot '$Acc' via other object" );
-    ok(!$other->$Acc(),             "   Method '$Acc' returns false" );
-    like( $warning, $Err_re,        "   Warning logged" );
-}
-
-### check if new() passes it's args correctly
-{   my $obj = $Class->new( $Acc );
-    ok( $obj,                       "Object created with accessors" );
-    isa_ok( $obj,                   $Class );
-    can_ok( $obj,                   $Acc );
-}
-
-1;
diff --git a/cpan/Object-Accessor/t/01_Object-Accessor-Subclassed.t b/cpan/Object-Accessor/t/01_Object-Accessor-Subclassed.t
deleted file mode 100644
index 29823e962e..0000000000
--- a/cpan/Object-Accessor/t/01_Object-Accessor-Subclassed.t
+++ /dev/null
@@ -1,51 +0,0 @@
-BEGIN { chdir 't' if -d 't' };
-
-use strict;
-use lib '../lib';
-use Test::More 'no_plan';
-use Data::Dumper;
-
-my $Class   = 'Object::Accessor';
-my $MyClass = 'My::Class';
-my $Acc     = 'foo';
-
-use_ok($Class);
-
-### establish another package that subclasses our own
-{   package My::Class;
-    use base 'Object::Accessor';
-}
-
-my $Object  = $MyClass->new;
-
-### check the object
-{   ok( $Object,                "Object created" );
-    isa_ok( $Object,            $MyClass );
-    isa_ok( $Object,            $Class );
-}
-
-### create an accessor
-{   ok( $Object->mk_accessors( $Acc ),
-                                "Accessor '$Acc' created" );
-    ok( $Object->can( $Acc ),   "   Object can '$Acc'" );
-    ok( $Object->$Acc(1),       "   Objects '$Acc' set" );
-    ok( $Object->$Acc(),        "   Objects '$Acc' retrieved" );
-}
-
-### check if we do the right thing when we call an accessor that's
-### not a defined function in the base class, and not an accessors
-### in the object either
-{   my $sub = eval { $MyClass->can( $$ ); };
-
-    ok( !$sub,                  "No sub from non-existing function" );
-    ok( !$@,                    "   Code handled it gracefully" );
-}
-
-### check if a method called on a class, that's not actually there
-### doesn't get confused as an object call;
-{   eval { $MyClass->$$ };
-
-    ok( $@,                     "Calling '$$' on '$MyClass' dies" );
-    like( $@, qr/from somewhere else/,
-                                "   Dies with an informative message" );
-}
diff --git a/cpan/Object-Accessor/t/02_Object-Accessor-allow.t b/cpan/Object-Accessor/t/02_Object-Accessor-allow.t
deleted file mode 100644
index 53ddf62690..0000000000
--- a/cpan/Object-Accessor/t/02_Object-Accessor-allow.t
+++ /dev/null
@@ -1,82 +0,0 @@
-BEGIN { chdir 't' if -d 't' };
-
-use strict;
-use lib '../lib';
-use Test::More 'no_plan';
-use Data::Dumper;
-
-my $Class = 'Object::Accessor';
-
-use_ok($Class);
-
-my $Object      = $Class->new;
-my $Acc         = 'foo';
-my $Allow       = qr/^\d+$/;
-my $Err_re      = qr/is an invalid value for '$Acc'/;
-my ($Ver_re)    = map { qr/$_/ } quotemeta qq['$Acc' (<undef>) is invalid];
-
-### stupid warnings
-### XXX this will break warning tests though if enabled
-$Object::Accessor::DEBUG = $Object::Accessor::DEBUG = 1 if @ARGV;
-
-
-### check the object
-{   ok( $Object,                "Object of '$Class' created" );
-    isa_ok( $Object,            $Class );
-}
-
-### create an accessor;
-{   my $warning;
-    local $SIG{__WARN__} = sub { $warning .= "@_" };
-
-    ok( $Object->mk_accessors( { $Acc => $Allow } ),
-                                "Accessor '$Acc' created" );
-
-    ok( $Object->can( $Acc ),   "   Can '$Acc'" );
-    ok(!$warning,               "   No warnings logged" );
-    is( $Object->ls_allow( $Acc ), $Allow,
-                                "   Proper allow handler stored" );
-
-
-}
-
-### try to use the accessor
-{   ### bad
-    {   my $warning;
-        local $SIG{__WARN__} = sub { $warning .= "@_" };
-
-        ok( !$Object->$Acc( $0 ),   "'$Acc' NOT set to '$0'" );
-        is( $Object->$Acc(), undef, "   '$Acc' still holds '<undef>'" );
-        like( $warning, $Err_re,    "   Warnings logged" );
-
-        ### reset warnings;
-        undef $warning;
-
-
-        my $ok = $Object->mk_verify;
-        ok( !$ok,                   "   Internal verify fails" );
-        like( $warning, $Ver_re,    "       Warning logged" );
-    }
-
-    $Object->mk_flush;
-
-    ### good
-    {   my $warning;
-        local $SIG{__WARN__} = sub { $warning .= "@_" };
-
-        ok( $Object->$Acc( $$ ),    "'$Acc' set to '$$'" );
-        is( $Object->$Acc(), $$,    "   '$Acc' still holds '$$'" );
-        ok(!$warning,               "   No warnings logged" );
-
-        ### reset warnings;
-        undef $warning;
-
-        my $ok = $Object->mk_verify;
-        ok( $ok,                    "   Internal verify succeeds" );
-        ok( !$warning,              "       No warnings" );
-
-    }
-
-    $Object->mk_flush;
-
-}
diff --git a/cpan/Object-Accessor/t/03_Object-Accessor-local.t b/cpan/Object-Accessor/t/03_Object-Accessor-local.t
deleted file mode 100644
index 1a9b070ef6..0000000000
--- a/cpan/Object-Accessor/t/03_Object-Accessor-local.t
+++ /dev/null
@@ -1,50 +0,0 @@
-BEGIN { chdir 't' if -d 't' };
-
-use strict;
-use lib '../lib';
-use Test::More 'no_plan';
-use Data::Dumper;
-
-my $Class = 'Object::Accessor';
-
-use_ok($Class);
-
-my $Object      = $Class->new;
-my $Acc         = 'foo';
-
-### stupid warnings
-### XXX this will break warning tests though if enabled
-$Object::Accessor::DEBUG = $Object::Accessor::DEBUG = 1 if @ARGV;
-
-
-### check the object
-{   ok( $Object,                "Object of '$Class' created" );
-    isa_ok( $Object,            $Class );
-}
-
-### create an accessor;
-{   my $warning;
-    local $SIG{__WARN__} = sub { $warning .= "@_" };
-
-    ok( $Object->mk_accessors( $Acc ),
-                                "Accessor '$Acc' created" );
-
-    ok( $Object->can( $Acc ),   "   Can '$Acc'" );
-    ok(!$warning,               "   No warnings logged" );
-
-
-}
-
-### scoped variables
-{   ok( 1,                      "Testing scoped values" );
-
-    $Object->$Acc( $$ );
-    is( $Object->$Acc, $$,      "   Value set to $$" );
-
-    ### set it to a scope
-    {   $Object->$Acc( $0 => \my $temp );
-        is( $Object->$Acc, $0,  "   Value set to $0" );
-    }
-
-    is( $Object->$Acc, $$,      "   Value restored to $$" );
-}
diff --git a/cpan/Object-Accessor/t/04_Object-Accessor-lvalue.t b/cpan/Object-Accessor/t/04_Object-Accessor-lvalue.t
deleted file mode 100644
index 6eb45b3cb2..0000000000
--- a/cpan/Object-Accessor/t/04_Object-Accessor-lvalue.t
+++ /dev/null
@@ -1,82 +0,0 @@
-BEGIN { chdir 't' if -d 't' };
-
-use strict;
-use lib '../lib';
-use Data::Dumper;
-
-BEGIN {
-    require Test::More;
-    Test::More->import(
-        # silly bbedit [
-        $] >= 5.008
-            ? 'no_plan'
-            : ( skip_all => "Lvalue objects require perl >= 5.8" )
-    );
-}
-
-my $Class   = 'Object::Accessor';
-my $LClass  =  $Class . '::Lvalue';
-
-use_ok($Class);
-
-my $Object      = $LClass->new;
-my $Acc         = 'foo';
-
-### stupid warnings
-### XXX this will break warning tests though if enabled
-$Object::Accessor::DEBUG = $Object::Accessor::DEBUG = 1 if @ARGV;
-
-
-### check the object
-{   ok( $Object,                "Object of '$LClass' created" );
-    isa_ok( $Object,            $LClass );
-    isa_ok( $Object,            $Class );
-    ok( $Object->mk_clone,      "   Object cloned" );
-}
-
-### create an accessor;
-{   ok( $Object->mk_accessors( $Acc ),
-                                "Accessor '$Acc' created" );
-
-    eval { $Object->$Acc = $$ };
-    ok( !$@,                    "lvalue assign successful $@" );
-    ok( $Object->$Acc,          "Accessor '$Acc' set" );
-    is( $Object->$Acc, $$,      "   Contains proper value" );
-}
-
-### test allow handlers
-{   my $acc   = 'bar';
-    my $clone = $Object->mk_clone;
-
-    ok( $clone,                 "Cloned the lvalue object" );
-
-    ### lets see if this causes a warning
-    {   my $warnings;
-        local $SIG{__WARN__} = sub { $warnings .= "@_" };
-
-        ok( $clone->mk_accessors({ $acc => sub { 0 } }),
-                                "   Created accessor '$acc'" );
-        like( $warnings, qr/not supported/,
-                                "       Got warning about allow handlers" );
-    }
-
-    ok( eval{ $clone->$acc = $$ },
-                                "   Allow handler ignored" );
-    ok( ! $@,                   "   No error occurred" );
-    is( $clone->$acc, $$,       "   Setting '$acc' worked" );
-}
-
-### test registering callbacks
-{   my $clone = $Object->mk_clone;
-    ok( $clone,                 "Cloned the lvalue object" );
-
-    {   my $warnings;
-        local $SIG{__WARN__} = sub { $warnings .= "@_" };
-        ok( ! $clone->register_callback( sub { } ),
-                                "Callback not registered" );
-
-        like( $warnings, qr/not supported/,
-                                "   Got warning about callbacks" );
-    }
-}
-
diff --git a/cpan/Object-Accessor/t/05_Object-Accessor-callback.t b/cpan/Object-Accessor/t/05_Object-Accessor-callback.t
deleted file mode 100644
index a2bbb170b0..0000000000
--- a/cpan/Object-Accessor/t/05_Object-Accessor-callback.t
+++ /dev/null
@@ -1,97 +0,0 @@
-BEGIN { chdir 't' if -d 't' };
-
-use strict;
-use lib '../lib';
-use Test::More 'no_plan';
-use Data::Dumper;
-
-my $Class   = 'Object::Accessor';
-my $LClass  = $Class . '::Lvalue';
-
-use_ok($Class);
-
-### stupid warnings
-### XXX this will break warning tests though if enabled
-$Object::Accessor::DEBUG = $Object::Accessor::DEBUG = 1 if @ARGV;
-
-my $Object      = $Class->new;
-my $Acc         = 'foo';
-my $Func        = 'register_callback';
-my $Called      = 0;
-my $RetVal      = $$;
-my $SetVal      = 1;
-
-### 6 tests
-my $Sub         = sub {
-        my $obj     = shift;
-        my $meth    = shift;
-        my $val     = shift;
-
-        $Called++;
-
-        ok( 1,                  "   In callback now" );
-        ok( $obj,               "       Object received" );
-        isa_ok( $obj, $Class,   "       Object");
-        is( $meth, $Acc,        "       Method is '$Acc'" );
-        isa_ok( $val, "ARRAY",  "       Value" );
-        scalar @$val
-            ? is( $val->[0], $SetVal,
-                                "       Attempted to set $SetVal" )
-            : ok( ! scalar @$val,
-                                "       This was a GET request" );
-
-        return $RetVal;
-};
-
-### set up the object
-{   ok( $Object,                "Object created" );
-    isa_ok( $Object,            $Class );
-    ok( $Object->mk_accessors( $Acc ),
-                                "   Accessor '$Acc' created" );
-    can_ok( $Object,            $Func );
-    ok( $Object->$Func( $Sub ), "   Callback registered" );
-}
-
-### test ___get and ___set
-{   $Called = 0;
-
-    my $clone = $Object->mk_clone;
-    ok( $clone,                 "Object cloned" );
-
-    my $val = $clone->___get($Acc);
-    is( $val, undef,            "   Direct get returns <undef>" );
-    ok( $clone->___set( $Acc => $SetVal ),
-                                "   Direct set is able to set the value" );
-    is( $clone->___get( $Acc ), $SetVal,
-                                "   Direct get returns $SetVal" );
-    ok( !$Called,               "   Callbacks didn't get called" );
-}
-
-### test callbacks on regular objects
-### XXX callbacks DO NOT work on lvalue objects. This is verified
-### in the lvalue test file, so we dont test here
-{   #diag("Running GET tests on regular objects");
-
-    my $clone   = $Object->mk_clone;
-
-    $Called = 0;
-    is( $clone->$Acc, $RetVal,   "   Method '$Acc' returns '$RetVal' " );
-    is( $clone->___get($Acc), undef,
-                                "   Direct get returns <undef>" );
-    ok( $Called,                "   Callback called" );
-
-
-    #diag("Running SET tests on regular objects");
-    $Called = 0;
-    ok( $clone->$Acc($SetVal),  "   Setting $Acc" );
-    ok( $Called,                "   Callback called" );
-
-    $Called = 0;
-    is( $clone->$Acc, $RetVal,  "   Returns $RetVal" );
-    ok( $Called,                "   Callback called" );
-
-    $Called = 0;
-    is( $clone->___get( $Acc ), $RetVal,
-                                "   Direct get returns $RetVal" );
-    ok( !$Called,               "   Callback not called" );
-}
diff --git a/cpan/Object-Accessor/t/06_Object-Accessor-alias.t b/cpan/Object-Accessor/t/06_Object-Accessor-alias.t
deleted file mode 100644
index f302a09523..0000000000
--- a/cpan/Object-Accessor/t/06_Object-Accessor-alias.t
+++ /dev/null
@@ -1,56 +0,0 @@
-BEGIN { chdir 't' if -d 't' };
-
-use strict;
-use lib '../lib';
-use Test::More 'no_plan';
-use Data::Dumper;
-
-my $Class = 'Object::Accessor';
-
-use_ok($Class);
-
-my $Object  = $Class->new;
-my $Acc     = 'foo';
-my $Alias   = 'bar';
-
-ok( $Object,                "Object created" );
-isa_ok( $Object, $Class,    "   Object" );
-
-### add an accessor
-{   my $rv = $Object->mk_accessors( $Acc );
-    ok( $rv,                "Created accessor '$Acc'" );
-    ok( $Object->$Acc( $$ ),"   Set value" );
-    is( $Object->$Acc, $$,  "   Retrieved value" );
-}
-
-### add an alias
-{   my $rv = $Object->mk_aliases( $Alias => $Acc );
-    ok( $rv,                "Created alias '$Alias'" );
-    ok( $Object->can( $Alias ),
-                            "   Alias '$Alias' exists" );
-    is( $Object->$Alias, $Object->$Acc,
-                            "   Alias & original return the same value" );
-
-    ok( $Object->$Alias( $$.$$ ),
-                            "   Changed value using alias" );
-    is( $Object->$Alias, $Object->$Acc,
-                            "   Alias & original return the same value" );
-}
-
-### test if cloning works
-{   my $clone = $Object->mk_clone;
-    ok( $clone,             "Cloned object" );
-
-    is_deeply( [sort $clone->ls_accessors], [sort $Object->ls_accessors],
-                            "   All accessors cloned" );
-
-    ok( $clone->$Acc( $$ ), "   Set value" );
-    is( $clone->$Alias, $clone->$Acc,
-                            "   Alias & original return the same value" );
-
-    ok( $clone->$Alias( $$.$$ ),
-                            "   Changed value using alias" );
-    is( $clone->$Alias, $clone->$Acc,
-                            "   Alias & original return the same value" );
-}
-