#! /usr/bin/perl

use strict;
use warnings;

{   package Base;
    use Devel::Size ();
    
    sub make_n {
        my ($class, $n) = @_;
        my @objects;
        push @objects, $class->new for 1..$n;
        return \@objects;
    }

    sub hidden_stuff { return }
    
    sub size_of_n {
        my ($class, $n) = @_;
        my $objects = $class->make_n( $n );
        my $stuff = [ $objects, $class->hidden_stuff ];
        return( Devel::Size::total_size( $stuff ), $objects );
    }
    
    sub do_something {
        my $class = shift;
        my $self = $class->new;
        $self->set_a( $self->get_a + 1 ) for ( 1 .. 100 );
        die unless $self->get_a == 101;
    }
}

{   package BlessedHash;
    use base qw( Base );
    
    sub new {
        bless { a => 1, b => 2, c => 3, d => 4 }, shift;
    }
    
    sub get_a { $_[0]->{a} };
    sub set_a { $_[0]->{a} = $_[1] };
}

{   package RefaddrCached;
    use Scalar::Util ();
    use base qw( Base );

    my (%a, %b, %c, %d);
    
    sub new {
        my $self = bless \my $_tmp, shift;
        $$self = Scalar::Util::refaddr( $self );
        $a{ $$self } = 1;
        $b{ $$self } = 2;
        $c{ $$self } = 3;
        $d{ $$self } = 4;
        return $self;
    }

    sub get_a { $a{ ${$_[0]} } };
    sub set_a { $a{ ${$_[0]} } = $_[1] };
    
    sub DESTROY {
        my $self = shift;
        delete $a{ $$self };
        delete $b{ $$self };
        delete $c{ $$self };
        delete $d{ $$self };
    }
    
    sub hidden_stuff { return [ \%a, \%b, \%c, \%d ] }
}

{   package RefaddrCall;
    use Scalar::Util qw( refaddr );
    use base qw( Base );

    my (%a, %b, %c, %d);
    
    sub new {
        my $self = bless \my $_tmp, shift;
        $a{ refaddr $self } = 1;
        $b{ refaddr $self } = 2;
        $c{ refaddr $self } = 3;
        $d{ refaddr $self } = 4;
        return $self;
    }

    sub get_a { $a{ refaddr $_[0] } };
    sub set_a { $a{ refaddr $_[0] } = $_[1] };
    
    sub DESTROY {
        my $self = shift;
        delete $a{ refaddr $self };
        delete $b{ refaddr $self };
        delete $c{ refaddr $self };
        delete $d{ refaddr $self };
    }
    
    sub hidden_stuff { return [ \%a, \%b, \%c, \%d ] }
}

{   package SelfAsIndex;
    use Scalar::Util qw( refaddr );
    use base qw( Base );

    my (%a, %b, %c, %d);
    
    sub new {
        my $self = bless \my $_tmp, shift;
        $a{ $self } = 1;
        $b{ $self } = 2;
        $c{ $self } = 3;
        $d{ $self } = 4;
        return $self;
    }

    sub get_a { $a{ $_[0] } };
    sub set_a { $a{ $_[0] } = $_[1] };
    
    sub DESTROY {
        my $self = shift;
        delete $a{ $self };
        delete $b{ $self };
        delete $c{ $self };
        delete $d{ $self };
    }
    
    sub hidden_stuff { return [ \%a, \%b, \%c, \%d ] }
}

{   package NumSelfAsIndex;
    use Scalar::Util qw( refaddr );
    use base qw( Base );

    my (%a, %b, %c, %d);
    
    sub new {
        my $self = bless \my $_tmp, shift;
        $a{ 0+$self } = 1;
        $b{ 0+$self } = 2;
        $c{ 0+$self } = 3;
        $d{ 0+$self } = 4;
        return $self;
    }

    sub get_a { $a{ 0+$_[0] } };
    sub set_a { $a{ 0+$_[0] } = $_[1] };
    
    sub DESTROY {
        my $self = shift;
        delete $a{ 0+$self };
        delete $b{ 0+$self };
        delete $c{ 0+$self };
        delete $d{ 0+$self };
    }
    
    sub hidden_stuff { return [ \%a, \%b, \%c, \%d ] }
}

{   package ClassStd;
    use base qw( Base );
    use Class::Std;

    my %a : ATTR( :get<a> :set<a> );
    my (%b, %c, %d) :ATTR;

    sub BUILD {
        my ($self, $id) = @_;
        $a{ $id } = 1;
        $b{ $id } = 2;
        $c{ $id } = 3;
        $d{ $id } = 4;
    }
    
    # just a guess - maybe more hidden behind the scenes
    sub hidden_stuff { return [ \%a, \%b, \%c, \%d ] }

}

use Devel::Symdump;
my @classes = sort grep { eval { $_->isa( 'Base' ) } && $_ ne 'Base' } 
    Devel::Symdump->rnew->packages;

my $n = 10000;
my @objects; 
foreach my $class (@classes) {
    my ($size, $objects) = $class->size_of_n( $n );
    # we keep the objects around just in case having heavily populated
    # attribute hashes affects the performance of the inside-out objects
    push @objects, $objects;
    print "$class x $n\t= $size bytes\n";
};

print "\n";

use Benchmark qw /cmpthese/;
cmpthese( -1, { map {
    my $class = $_;
    $class => sub { $class->do_something }
} @classes});