[libcatmandu-perl] 08/46: Adding a hashmap binder for statistical reporting

[Jonas Smedegaard]

This is an automated email from the git hooks/post-receive script.

js pushed a commit to tag 0.9205
in repository libcatmandu-perl.

commit 7b79f06fa0d5a19876620a8bec559b85e9f80cac
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date:   Thu Jul 3 14:40:56 2014 +0200

    Adding a hashmap binder for statistical reporting
---
 lib/Catmandu/Fix/Bind/hashmap.pm | 160 +++++++++++++++++++++++++++++++++++++++
 t/Catmandu-Exporter-Null.t       |  25 ++++++
 t/Catmandu-Fix-Bind-hashmap.t    | 110 +++++++++++++++++++++++++++
 3 files changed, 295 insertions(+)

diff --git a/lib/Catmandu/Fix/Bind/hashmap.pm b/lib/Catmandu/Fix/Bind/hashmap.pm
new file mode 100644
index 0000000..ffc8576
--- /dev/null
+++ b/lib/Catmandu/Fix/Bind/hashmap.pm
@@ -0,0 +1,160 @@
+package Catmandu::Fix::Bind::hashmap;
+
+use Moo;
+use Catmandu::Util qw(:is);
+use namespace::clean;
+
+with 'Catmandu::Fix::Bind';
+
+has exporter => (is => 'ro' , default => sub { 'JSON' });
+has store    => (is => 'ro');
+has unqiue   => (is => 'ro' , default => sub { 0 });
+has count    => (is => 'ro');
+has join     => (is => 'ro');
+has hash     => (is => 'lazy');
+
+sub _build_hash {
+    +{};
+}
+
+sub add_to_hash {
+    my ($self,$key,$val) = @_;
+    if ($self->count) {
+        $self->hash->{$key} += 1;
+    }
+    elsif ($self->unqiue) {
+        $self->hash->{$key}->{$val} = 1;
+    }
+    else {
+        push @{$self->hash->{$key}}  , $val;
+    }
+}
+
+sub bind {
+    my ($self,$data,$code,$name) = @_;
+    my $key   = $data->{key};
+    my $value = $data->{value};
+
+    if (defined $key) {
+        if (is_string($key)) {
+            $self->add_to_hash($key,$value);
+        }
+        elsif (is_array_ref($key)) {
+            for (@$key) {
+                $self->add_to_hash($_,$value);
+            }
+        }
+        else {
+            warn "$key is not a string or array for $value";
+        }
+    }
+
+    $code->($data);
+}
+
+sub DESTROY {
+    my ($self) = @_;
+    my $h = $self->hash;
+    my $e;
+
+    if ($self->store) {
+        $e = Catmandu->store($self->store);
+    }
+    else {
+        $e = Catmandu->exporter($self->exporter);
+    }
+
+    my $id = 0;
+    for (sort keys %$h) {
+        my $v;
+
+        if ($self->count) {
+            $v = $h->{$_};
+        }
+        elsif ($self->unqiue) {
+            $v = [ keys %{$h->{$_}} ];
+        }
+        else {
+            $v = $h->{$_};
+        }
+
+        if (is_array_ref($v) && $self->join) {
+            $v = join $self->join , @$v;
+        }
+
+
+        $e->add({ _id => sprintf("%9.9d",++$id) ,  value => {$_ => $v }});
+    }
+
+    $e->commit;
+}
+
+=head1 NAME
+
+Catmandu::Fix::Bind::hashmap - a binder to add key/value pairs to an internal hashmap
+
+=head1 SYNOPSIS
+
+ # Find all ISBN in a stream
+ do hashmap(exporter => JSON)
+    copy_field(isbn,key)
+    copy_field(_id,value)
+ end
+
+ # will export to the YAML exporter a hash map containing all isbn occurrences in the stream
+
+ { "_id": "000000001" , "value":{ "ISBN1":0121,12912,121}}
+ { "_id": "000000002" , "value":{ "ISBN2":102012}}
+
+ # Count the number of ISBN occurrences in a stream
+ # File: count.fix:
+ do hashmap(count: 1)
+    copy_field(isbn,key)
+ end
+
+ # Use the Null exporter to suppress the normal output
+ $ cat /tmp/data.json | catmandu convert JSON --fix count.fix to Null
+
+=head1 DESCRIPTION
+
+The hashmap binder will insert all key/value pairs given to a internal hashmap that can be exported
+using an Catmandu::Exporter.
+
+If the key is an ARRAY, then multiple key/value pairs will be inserted into the hashmap.
+
+By default all the values will be added as an array to the hashmap. Every key will have one
+or more values.
+
+=head1 CONFIGURATION
+
+=head2 exporter: EXPORTER
+
+The name of an exporter to send the results to. Default: JSON
+
+=head2 store: STORE
+
+Send the output to a store instead of an exporter.
+
+=head2 unique: 0|1
+
+All the values for the a key will be unique.
+
+=head2 join: CHAR
+
+Join all the values of a key using a delimiter.
+
+=head2 count: 0|1
+
+Don't store the values only count the number of key occurences.
+
+=head1 AUTHOR
+
+Patrick Hochstenbach - L<Patrick.Hochstenbach at UGent.be>
+
+=head1 SEE ALSO
+
+L<Catmandu::Fix::Bind>
+
+=cut
+
+1;
\ No newline at end of file
diff --git a/t/Catmandu-Exporter-Null.t b/t/Catmandu-Exporter-Null.t
new file mode 100644
index 0000000..74b9ac9
--- /dev/null
+++ b/t/Catmandu-Exporter-Null.t
@@ -0,0 +1,25 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+
+my $pkg;
+BEGIN {
+    $pkg = 'Catmandu::Exporter::Null';
+    use_ok $pkg;
+}
+require_ok $pkg;
+
+my $data = [{'a' => 'moose', b => '1'}, {'a' => 'pony', b => '2'}, {'a' => 'shrimp', b => '3'}];
+my $out = "";
+
+my $exporter = $pkg->new(file => \$out);
+isa_ok $exporter, $pkg;
+
+$exporter->add($_) for @$data;
+$exporter->commit;
+
+is $out,'', "Null is empty ok";
+is $exporter->count,3, "Count ok";
+ 
+done_testing;
diff --git a/t/Catmandu-Fix-Bind-hashmap.t b/t/Catmandu-Fix-Bind-hashmap.t
new file mode 100644
index 0000000..7468a32
--- /dev/null
+++ b/t/Catmandu-Fix-Bind-hashmap.t
@@ -0,0 +1,110 @@
+#!/usr/bin/env perl
+use lib 't/lib';
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+use Catmandu::Fix;
+use Catmandu::Importer::Mock;
+use Catmandu::Util qw(:is);
+use Data::Dumper;
+
+my $pkg;
+BEGIN {
+    $pkg = 'Catmandu::Fix::Bind::hashmap';
+    use_ok $pkg;
+}
+require_ok $pkg;
+
+my $fixes =<<EOF;
+do hashmap()
+  add_field(foo,bar)
+end
+EOF
+
+my $fixer = Catmandu::Fix->new(fixes => [$fixes]);
+
+ok $fixer , 'create fixer';
+
+is_deeply $fixer->fix({}), {foo => 'bar'} , 'testing add_field';
+
+$fixes =<<EOF;
+do hashmap()
+end
+EOF
+
+$fixer = Catmandu::Fix->new(fixes => [$fixes]);
+
+is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing zero fix functions';
+
+$fixes =<<EOF;
+do hashmap()
+  unless exists(foo)
+  	add_field(foo,bar)
+  end
+end
+EOF
+
+$fixer = Catmandu::Fix->new(fixes => [$fixes]);
+
+is_deeply $fixer->fix({}), {foo => 'bar'} , 'testing unless';
+
+$fixes =<<EOF;
+do hashmap()
+  if exists(foo)
+  	add_field(foo2,bar)
+  end
+end
+EOF
+
+$fixer = Catmandu::Fix->new(fixes => [$fixes]);
+
+is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar', foo2 => 'bar'} , 'testing if';
+
+$fixes =<<EOF;
+do hashmap()
+  reject exists(foo)
+end
+EOF
+
+$fixer = Catmandu::Fix->new(fixes => [$fixes]);
+
+ok !defined $fixer->fix({foo => 'bar'}) , 'testing reject';
+
+$fixes =<<EOF;
+do hashmap()
+  select exists(foo)
+end
+EOF
+
+$fixer = Catmandu::Fix->new(fixes => [$fixes]);
+
+is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing select';
+
+$fixes =<<EOF;
+do hashmap()
+ do hashmap()
+  do hashmap()
+   add_field(foo,bar)
+  end
+ end
+end
+EOF
+
+$fixer = Catmandu::Fix->new(fixes => [$fixes]);
+
+is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing nesting';
+
+$fixes =<<EOF;
+add_field(before,ok)
+do hashmap()
+   add_field(inside,ok)
+end
+add_field(after,ok)
+EOF
+
+$fixer = Catmandu::Fix->new(fixes => [$fixes]);
+
+is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar', before => 'ok', inside => 'ok', after => 'ok'} , 'before/after testing';
+
+done_testing 11;
\ No newline at end of file

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatmandu-perl.git