#!/usr/bin/perl

use strict;
use Benchmark qw( cmpthese );
use Data::Dumper;
#use Smart::Comments;



$\="\n";          # print to say
my $test_flag=1;



#- basic vars to access

my %hash=( a=>1 );
my ($b,$c)= (2,3);
my $b_ref=\$b;


#- simple getters

sub get_hash {
    return $hash{a};
}

sub get_scalar {
    return $b;
}



#-  lvalue getters

sub lv_hash :lvalue {
    $hash{a};
}

sub lv_scalar :lvalue {
    $b;
}



#-  lvalue tied getters

sub lv_tie_scalar :lvalue {
    $c;
}

tie $c, 'Exp_tiescalar', 10;




test_tie();








#-------------------------------------------------
#                   Tie Class
#-------------------------------------------------

{
    package Exp_tiescalar;

    sub TIESCALAR {
    my $class = shift;
    my $obj = shift;

    return bless \$obj, $class;
    }

    sub FETCH {
    my $self = shift;
    return $$self;
    }

    sub STORE {
    my $self = shift;
    $$self=shift;
    }
}




#-------------------------------------------------
#                   OOP
#-------------------------------------------------

# for simplification  lexical class vars are accessed

{
    package Exp_class;

    my ($scalar,$tie_scalar)=(1,2);

    sub get_scalar {
    return $scalar;
    }

    sub lv_scalar :lvalue {
    $scalar;
    }


    tie $tie_scalar, 'Exp_tiescalar', 10;

    sub lv_tie_scalar :lvalue {
    $tie_scalar;
    }


    sub new {
    my $class=shift;
    my $obj_dummy;
    my $obj=\$obj_dummy;

    bless $obj,$class;
    return $obj;

    }

}



my $obj=Exp_class->new();


test_obj();






#__END__




#-------------------------------------------------
#                 Testcode
#-------------------------------------------------


my $res;        # dummyresult

my $times=255;  # multiplikator to pimp up runtime


my %testcases= (
        lv_hash  =>           sub { $res= lv_hash for (0..$times) },
        lv_scalar =>          sub { $res= lv_scalar   for (0..$times)}
+,
    lv_tie_scalar =>      sub { $res= lv_tie_scalar   for (0..$times)}
+,

        get_hash  =>          sub { $res= get_hash for (0..$times) },
        get_scalar =>         sub { $res= get_scalar   for (0..$times)
+},

    hash    =>            sub { $res=$hash{a}  for (0..$times)},
    scalar    =>          sub { $res=$b  for (0..$times)},
    scalar_ref    =>      sub { $res=$$b_ref  for (0..$times)},


        obj_get_scalar =>     sub { $res= $obj->get_scalar   for (0..$
+times)},
    obj_lv_scalar =>      sub { $res= $obj->lv_scalar   for (0..$times
+)},
    obj_lv_tie_scalar =>  sub { $res= $obj->lv_tie_scalar   for (0..$t
+imes)},

    );






#-------------------------------------------------
#               Benchmarks
#-------------------------------------------------




sub hkgrep (&\%) {              # filter hash by keypattern
    my $grepcode=shift;
    my $hash_ref=shift;

    my %hash=%$hash_ref;

    my @filterd_keys=grep {&$grepcode} keys %hash;
    my %filterd_hash;

    @filterd_hash{@filterd_keys}= @hash{ @filterd_keys };

    return %filterd_hash;
}




sub bench (&) {
    my $grepcode=shift;

    my %filterd_hash = hkgrep {&$grepcode} %testcases ;

    cmpthese 1000 , \%filterd_hash;

}



bench {/^obj/};
bench {/^lv_/};
bench {/scalar/};




#-------------------------------------------------
#                Tests
#-------------------------------------------------



sub test_obj {
    return unless $test_flag;
    print $obj->get_scalar();
    print $obj->lv_scalar;
    print $obj->lv_tie_scalar;
}

sub test_tie {
    return unless $test_flag;
    print lv_tie_scalar;
    lv_tie_scalar=99;
    print lv_tie_scalar;
}
[download]