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


In reply to Re: May Thy Closures Be Blessed by Abigail-II
in thread May Thy Closures Be Blessed by hardburn

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":