From f14bd8343010ad96104965029e36c5a65d231571 Mon Sep 17 00:00:00 2001
From: Jon Robertson <jonrober@stanford.edu>
Date: Sat, 7 Feb 2015 16:09:12 -0800
Subject: Added an object history report to wallet-report

Took code from Commerzbank AG and refactored to add to wallet-report.
This does a complete dump of all object history for searching on.

Change-Id: Id22c51d2938ad90e0c6a19aaa016501a1ba333b3
---
 perl/lib/Wallet/Report.pm | 42 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 42 insertions(+)

(limited to 'perl/lib/Wallet')

diff --git a/perl/lib/Wallet/Report.pm b/perl/lib/Wallet/Report.pm
index 2382d87..912bc17 100644
--- a/perl/lib/Wallet/Report.pm
+++ b/perl/lib/Wallet/Report.pm
@@ -242,6 +242,48 @@ sub objects {
     return @objects;
 }
 
+# Returns a list of all object_history records stored in the wallet database
+# including all of their fields.  On error and for an empty database, the
+# empty list will be returned.  To distinguish between an empty list and an
+# error, call error(), which will return undef if there was no error.
+# Farms out specific statement to another subroutine for specific search
+# types, but each case should return ob_type and ob_name in that order.
+sub objects_history {
+    my ($self, $type, @args) = @_;
+    undef $self->{error};
+
+    # All fields in the order we want to see them.
+    my @fields = ('oh_on', 'oh_by', 'oh_type', 'oh_name', 'oh_action',
+                  'oh_from');
+
+    # Get the search and options array refs from specific functions.
+    my %search  = ();
+    my %options = (order_by => \@fields,
+                   select   => \@fields);
+
+    # Perform the search and return on any errors.
+    my @objects;
+    my $schema = $self->{schema};
+    eval {
+        my @objects_rs
+            = $schema->resultset('ObjectHistory')->search (\%search,
+                                                           \%options);
+        for my $object_rs (@objects_rs) {
+            my @rec;
+            for my $field (@fields) {
+                push (@rec, $object_rs->get_column($field));
+            }
+            push (@objects, \@rec);
+        }
+    };
+    if ($@) {
+        $self->error ("cannot list objects: $@");
+        return;
+    }
+
+    return @objects;
+}
+
 ##############################################################################
 # ACL reports
 ##############################################################################
-- 
cgit v1.2.3