diff options
author | Jon Robertson <jonrober@stanford.edu> | 2015-02-07 16:09:12 -0800 |
---|---|---|
committer | Jon Robertson <jonrober@stanford.edu> | 2015-06-08 15:24:34 -0700 |
commit | f14bd8343010ad96104965029e36c5a65d231571 (patch) | |
tree | ad6d442a90102beebec32636e984fb8b4699f42d /perl/lib | |
parent | e7aed7182fe22c0f89754f96dfa6b2c6c2b665b0 (diff) |
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
Diffstat (limited to 'perl/lib')
-rw-r--r-- | perl/lib/Wallet/Report.pm | 42 |
1 files changed, 42 insertions, 0 deletions
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 ############################################################################## |