Permalink
Browse files

Add hash methods to compare

  • Loading branch information...
1 parent 4d87257 commit 7d16b83602742f278d68b3a6122a1813beca1ad7 @yannk committed Oct 13, 2009
Showing with 81 additions and 1 deletion.
  1. +30 −1 lib/Data/Layered.pm
  2. +51 −0 t/02_bench.t
View
@@ -7,7 +7,7 @@ use Exporter;
use vars qw(@ISA @EXPORT_OK);
@ISA = qw(Exporter);
-@EXPORT_OK = qw(layered_get);
+@EXPORT_OK = qw(layered_get layered_get2 layered_get3);
=encoding utf-8
@@ -109,6 +109,35 @@ sub layered_get {
return \@results;
}
+sub layered_get2 {
+ my ($class) = @_;
+ shift() unless ref $class;
+ my ($keys, $layers) = @_;
+
+ ## degenerated cases
+ return {} unless $keys;
+ return $keys unless $layers;
+
+ my %results = ();
+ my @need_keys = @$keys;
+
+ for my $layer (@$layers) {
+ $layer->(\@need_keys, \%results);
+
+ # keys which have been resolved will have a key in %results
+ # the rest will need to be attempted at the next layer
+ @need_keys = grep { ! exists $results{$_} } @need_keys;
+ }
+
+ return \%results;
+}
+
+sub layered_get3 {
+ my $keys = $_[0];
+ my $res = layered_get2(@_);
+ return [ map { $res->{$_} } @$keys ];
+}
+
=head1 AUTHOR
Yann Kerherve E<lt>yannk@cpan.orgE<gt>
View
@@ -0,0 +1,51 @@
+use Find::Lib '../lib';
+use strict;
+use warnings;
+use Benchmark 'timethese';
+
+use Data::Layered 'layered_get', 'layered_get2', 'layered_get3';
+
+## define some caches
+my $L1 = {};
+my $L2 = {};
+my $keys = [];
+for (1 .. 50000) {
+ $L1->{ int rand (100000) } = int rand (1000);
+ $L2->{ int rand (100000) } = int rand (1000);
+ push @$keys, int rand (100000);
+}
+my %seen;
+@$keys = grep { ! $seen{$_}++ } @$keys;
+
+my $l1 = sub { [ @$L1{ @{$_[0]} } ] };
+my $l2 = sub { [ @$L2{ @{$_[0]} } ] };
+
+my $l1_2 = sub {
+ my ($keys, $res) = @_;
+ for my $k (@$keys) {
+ $res->{$k} = $L1->{$k};
+ }
+};
+
+my $l2_2 = sub {
+ my ($keys, $res) = @_;
+ for my $k (@$keys) {
+ $res->{$k} = $L2->{$k};
+ }
+};
+
+timethese 5, {
+ layered_get => sub {
+ my $res = layered_get( $keys, [ $l1, $l2 ]);
+ #warn scalar grep { defined } @$res;
+ },
+ layered_get2 => sub {
+ my $res = layered_get2( $keys, [ $l1_2, $l2_2 ]);
+ #warn scalar grep { defined $res->{$_} } keys %$res;
+ },
+
+ layered_get3 => sub {
+ my $res = layered_get3( $keys, [ $l1_2, $l2_2 ]);
+ #warn scalar grep { defined $res->{$_} } keys %$res;
+ },
+};

0 comments on commit 7d16b83

Please sign in to comment.