History: add unique event index

quattor · Oct 10, 2015 · 0d8dede · 0d8dede
1 parent 18a43ee
commit 0d8dede
Show file tree

Hide file tree

Showing 3 changed files with 41 additions and 7 deletions.
diff --git a/src/main/perl/History.pm b/src/main/perl/History.pm
@@ -11,6 +11,9 @@ use warnings;
 use LC::Exception qw (SUCCESS);
 use Readonly;
 
+use parent qw(Exporter);
+our @EXPORT_OK = qw($IDX $ID $TS $REF);
+
 # refaddr was added between 5.8.0 and 5.8.8
 use Scalar::Util qw(blessed refaddr);
 
@@ -22,11 +25,13 @@ Readonly my $HISTORY => 'HISTORY';
 
 Readonly my $EVENTS => 'EVENTS';
 Readonly my $LAST => 'LAST';
+Readonly my $NEXTIDX => 'NEXTIDX';
 Readonly my $INSTANCES => 'INSTANCES';
 
-Readonly my $ID => 'ID';
-Readonly my $TS => 'TS';
-Readonly my $REF => 'REF';
+Readonly our $IDX => 'IDX';
+Readonly our $ID => 'ID';
+Readonly our $TS => 'TS';
+Readonly our $REF => 'REF';
 
 
 # DESTROY issues with Readonly
@@ -112,6 +117,10 @@ an array reference holding all events.
 
 The latest state of each id
 
+=item C<$NEXTIDX>
+
+The index of the next event.
+
 =item optional C<$INSTANCES>
 
 If C<keep_instances> is set, an INSTANCES attribute is also added,
@@ -128,11 +137,12 @@ By default, INSTANCES are not kept.
 
 sub init_history
 {
-    my ($self, $keep_instances) = @_;
+    my ($self, $keep_instances, $nextidx) = @_;
 
     $self->{$HISTORY} = {
         $EVENTS => [],
         $LAST => {},
+        $NEXTIDX => $nextidx || 0,
     };
 
     $self->{$HISTORY}->{$INSTANCES} = {} if $keep_instances;
@@ -158,6 +168,10 @@ Following metadata is added automatically
 
 =over
 
+=item C<IDX>
+
+The unique event index, increases one per event.
+
 =item C<ID>
 
 The identifier
@@ -197,6 +211,7 @@ sub event
         $id .= $obj;
     }
 
+    $metadata{$IDX} = $self->{$HISTORY}->{$NEXTIDX}++;
     $metadata{$ID} = $id;
     $metadata{$REF} = $ref;
     $metadata{$TS} = $self->_now();

diff --git a/src/test/perl/history.t b/src/test/perl/history.t
@@ -10,17 +10,18 @@ use LC::Exception qw (SUCCESS);
 use myhistory;
 use object_ok;
 
+use CAF::History qw($IDX $ID $TS $REF);
+
 use Scalar::Util qw(refaddr);
 use Readonly;
+
 Readonly my $HISTORY => 'HISTORY';
 
 Readonly my $EVENTS => 'EVENTS';
 Readonly my $LAST => 'LAST';
+Readonly my $NEXTIDX => 'NEXTIDX';
 Readonly my $INSTANCES => 'INSTANCES';
 
-Readonly my $ID => 'ID';
-Readonly my $TS => 'TS';
-Readonly my $REF => 'REF';
 
 my $mockh = Test::MockModule->new('CAF::History');
 my $mocko = Test::MockModule->new('object_ok');
@@ -30,6 +31,12 @@ my $obj_destroy = 0;
 $mocko->mock('close', sub {$obj_close++;});
 $mocko->mock('DESTROY', sub {$obj_destroy++;});
 
+
+is($IDX, 'IDX', "exported IDX");
+is($ID, 'ID', "exported ID");
+is($TS, 'TS', "exported TS");
+is($REF, 'REF', "exported REF");
+
 =pod
 
 =head2 not initialized
@@ -59,6 +66,7 @@ isa_ok($h, 'CAF::History', 'h is a CAF::History subclass');
 is_deeply($h->{$HISTORY}, {
     $EVENTS => [],
     $LAST => {},
+    $NEXTIDX => 0,
 }, "HISTORY attr initialized correct (no INSTANCES by default)");
 
 =head2 _now
@@ -89,6 +97,7 @@ isa_ok($obj, $isa, 'obj is a object_ok instance');
 $h->event($obj, reason => 'simple test');
 is_deeply($h->{$HISTORY}->{$EVENTS}, [
     {
+        $IDX => 0,
         $ID => $oid,
         $REF => $isa,
         $TS => 2,
@@ -122,6 +131,7 @@ isa_ok($h2, 'myhistory', 'h2 is a myhistory instance');
 is_deeply($h2->{$HISTORY}, {
     $EVENTS => [],
     $LAST => {},
+    $NEXTIDX => 0,
     $INSTANCES => {},
 }, "h2 HISTORY attr initialized correct (INSTANCES enabled)");
 
@@ -136,24 +146,28 @@ $h2->event($obj, something => 'else');
 
 is_deeply($h2->{$HISTORY}->{$EVENTS}, [
     {
+        $IDX => 0,
         $ID => " string",
         $REF => '',
         $TS => 3,
         type => 'scalar',
     },
     {
+        $IDX => 1,
         $ID => $hid,
         $REF => 'HASH',
         $TS => 4,
         type => 'hashref',
     },
     {
+        $IDX => 2,
         $ID => $oid,
         $REF => $isa,
         $TS => 5,
         type => 'instance',
     },
     {
+        $IDX => 3,
         $ID => $oid,
         $REF => $isa,
         $TS => 6,
@@ -192,12 +206,14 @@ my $ans = $h2->query_raw($match);
 diag "no filter ", explain $ans;
 is_deeply($ans, [
     {
+        $IDX => 0,
         $ID => " string",
         $REF => '',
         $TS => 3,
         type => 'scalar',
     },
     {
+        $IDX => 3,
         $ID => $oid,
         $REF => $isa,
         $TS => 6,

diff --git a/src/test/perl/test-caffilewriter.t b/src/test/perl/test-caffilewriter.t
@@ -202,13 +202,15 @@ diag explain $this_app->{HISTORY}->{EVENTS};
 #   close on new one
 is_deeply($this_app->{HISTORY}->{EVENTS}, [
     {
+        IDX => 0,
         ID => $fhid,
         REF => 'CAF::FileWriter',
         TS => 0,
         filename =>  $INC{"CAF/FileWriter.pm"},
         init => 1,
     },
     {
+        IDX => 1,
         ID => $ofhid,
         REF => 'CAF::FileWriter',
         TS => 0,
@@ -218,6 +220,7 @@ is_deeply($this_app->{HISTORY}->{EVENTS}, [
         noaction => 1,
     },
     {
+        IDX => 2,
         ID => $fhid,
         REF => 'CAF::FileWriter',
         TS => 0,