#! perl -slw
use strict;
package Cish::Person;
use Class::InstanceVariables qw(
    $first
    $last
    $middle
);

sub new{
    my $class = shift;
    local $self = instance();
    ( $first, $middle, $last ) = @_;
    $self;
}

sub full_name{
    local $self = shift;
    "$last, $first $middle";
}

sub marry{
    local $self = shift;
    my $spouse = shift;
    "$first married " . $spouse->first();
}

package Perlish::Person;

sub new{
    my $class = shift;
    my $self = {};
    @{ $self }{ qw[ first middle last ] } = @_;
    bless $self, $class;
}

sub full_name{
    my $self = shift;
    join ' ', @{ $self }{ qw[last first middle ] };
}

sub marry{
    my $self = shift;
    my $spouse = shift;
    "$self->{ first } married " . $spouse->{ first };
}

package main;
use Benchmark qw[ cmpthese ];

my %tests = (
    Cish => q[
        my $john = new Cish::Person(qw(John F Jones));
        my $sue = new Cish::Person(qw(Suzy P Edwards));

        print STDERR $john->full_name();
        print STDERR $sue->full_name();
        print STDERR $john->marry($sue);
    ],
    Perlish => q[
        my $john    = new Perlish::Person(qw(John F Jones));
        my $sue        = new Perlish::Person(qw(Suzy P Edwards));

        print STDERR $john->full_name();
        print STDERR $sue->full_name();
        print STDERR $john->marry($sue);
    ],
);

cmpthese( -3, \%tests );
[download]

use strict;
package Class::InstanceVariables;

sub import{
    my $class = shift;
    my $caller = caller();
    my $ties = <<"EOH"
# line 1 "@{[__PACKAGE__]} eval @ line @{[__LINE__]}"
package $caller;
no strict;
EOH

. <<'EOS';

$self='';
sub TIESCALAR{
    my $class = shift;
    my $var = shift;
    bless \$var, $class;
}

sub FETCH{
    my $thing = shift;
    $self->{ $$thing };
}

sub STORE{
    my $thing = shift;
    $self->{ $$thing } = shift;
}
EOS

    no strict 'refs';
    *{$caller."::self"} = \${$caller."::self"};
    foreach my $ivar (@_) {
        if($ivar!~/^\$([A-Za-z_]\w*)$/) {
            die "$ivar is not a valid variable name!\n";
        }
        my $varname = $1;
        *{$caller."\:\:$varname"} = \${$caller."\:\:$varname"};
        $ties .= "sub $varname : lvalue { \$_[0]->{$varname} }\n";
        $ties .= "tie \$$varname,'$caller','$varname';\n";
    }
    *{$caller."::instance"}=sub{
         bless {}, $caller;
    };

    eval $ties;
    if ($@) {
        die $@;
    }
}
1;
[download]