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  ############################################################################## | 
