diff options
| -rw-r--r-- | perl/lib/Wallet/Report.pm | 42 | ||||
| -rwxr-xr-x | server/wallet-report | 8 |
2 files changed, 49 insertions, 1 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 ############################################################################## diff --git a/server/wallet-report b/server/wallet-report index 1c8f914..bc499d4 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -23,6 +23,7 @@ Wallet reporting help: objects All objects objects acl <acl> Objects granting permissions to that ACL objects flag <flag> Objects with that flag set + objects history History of all objects objects owner <owner> Objects owned by that owner objects type <type> Objects of that type objects unused Objects that have never been gotten @@ -75,7 +76,12 @@ sub command { print $HELP; } elsif ($command eq 'objects') { die "too many arguments to objects\n" if @args > 2; - my @objects = $report->objects (@args); + my @objects; + if (@args && $args[0] eq 'history') { + @objects = $report->objects_history (@args); + } else { + @objects = $report->objects (@args); + } if (!@objects and $report->error) { die $report->error, "\n"; } |