Inside Out objects are faster than the closure based - but compared to "traditional" objects, the difference is small:
#!/usr/bin/perl
use strict;
use warnings;
use Benchmark qw /cmpthese/;
use Carp;
package Class_Closure;
sub new {
my $class = shift;
my %args = @_;
my %field = (
name => $args {name} || "abigail",
colour => $args {colour} || "pink",
age => $args {age} || 100,
class => $class,
);
bless sub {
my $name = shift;
my ($package, $filename, $line) = caller;
die "Attempt to access private class data " .
"for $field{class} at $filename line $line\n"
unless UNIVERSAL::isa ($package => __PACKAGE__);
die "No such field '$name' at $filename line $line\n"
unless exists $field{$name};
die "You can't change the class name at $filename line $line\n
+"
if $name eq 'class';
$field {$name} = shift if @_;
$field {$name}
} => $class;
}
sub name {my $self = shift; $self -> (name => @_)}
sub colour {my $self = shift; $self -> (colour => @_)}
sub age {my $self = shift; $self -> (age => @_)}
sub format {
my $self = shift;
join " " => $self -> ('name'), $self -> ('colour'), $self -> ('age
+');
}
package Class_Inside_Out;
my %name;
my %colour;
my %age;
sub new {
my $key = bless \(my $dummy) => shift;
my %args = @_;
$name {$key} = $args {name} || "abigail";
$colour {$key} = $args {colour} || "pink";
$age {$key} = $args {age} || 100;
$key;
}
sub name {
my $key = shift;
$name {$key} = shift if @_;
$name {$key};
}
sub colour {
my $key = shift;
$colour {$key} = shift if @_;
$colour {$key};
}
sub age {
my $key = shift;
$age {$key} = shift if @_;
$age {$key};
}
sub format {
my $key = shift;
join " " => $name {$key}, $colour {$key}, $age {$key};
}
package Class_Traditional;
sub new {
my $class = shift;
my %args = @_;
bless {name => $args {name} || "abigail",
colour => $args {colour} || "pink",
age => $args {age} || 100} => $class;
}
sub name {
my $self = shift;
$self -> {name} = shift if @_;
$self -> {name}
}
sub colour {
my $self = shift;
$self -> {colour} = shift if @_;
$self -> {colour}
}
sub age {
my $self = shift;
$self -> {age} = shift if @_;
$self -> {age}
}
sub format {
my $self = shift;
join " " => @$self {qw /name colour age/};
}
package main;
our $obj_c = Class_Closure -> new;
our $obj_i = Class_Inside_Out -> new;
our $obj_t = Class_Traditional -> new;
our @names = ("Larry Wall", "Damian Conway", "Nicholas Clark",
"Gurusamy Sarathy", "Chip Salzenberg",
"Rafael Garcia-Suarez");
our @colours = qw /red green blue white yellow orange brown purple vio
+let/;
#
# Test.
#
my $name = $names [rand @names];
my $colour = $colours [rand @colours];
my $age = 1 + int rand 100;
foreach my $i ([obj_c => $obj_c], [obj_i => $obj_i], [obj_t => $obj_t]
+) {
$i -> [1] -> name ($name);
$i -> [1] -> colour ($colour);
$i -> [1] -> age ($age);
die $i -> [0] unless "$name $colour $age" eq $i -> [1] -> format;
}
our $dummy;
cmpthese -1 => {
closure => 'foreach my $n (@names) {
foreach my $c (@colours) {
my $age = 1 + int rand 100;
$obj_c -> name ($n);
$obj_c -> colour ($c);
$obj_c -> age ($age);
$dummy = $obj_c -> format;
}
}',
inside_out => 'foreach my $n (@names) {
foreach my $c (@colours) {
my $age = 1 + int rand 100;
$obj_i -> name ($n);
$obj_i -> colour ($c);
$obj_i -> age ($age);
$dummy = $obj_i -> format;
}
}',
traditional => 'foreach my $n (@names) {
foreach my $c (@colours) {
my $age = 1 + int rand 100;
$obj_t -> name ($n);
$obj_t -> colour ($c);
$obj_t -> age ($age);
$dummy = $obj_t -> format;
}
}',
};
__END__
Rate closure inside_out traditional
closure 355/s -- -25% -75%
inside_out 473/s 33% -- -67%
traditional 1436/s 304% 203% --
Abigail