Add a report of all objects that have never been downloaded

Add a objects unused report to wallet-report and Wallet::Report,
returning all objects that have never been downloaded (in other words,
have never been the target of a get command).

5 files changed, 80 insertions, 6 deletions

diff --git a/NEWS b/NEWS
index f9d4a9a..79a24d1 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,11 @@
                        User-Visible wallet Changes
 
+wallet 0.12 (unreleased)
+
+    Add a objects unused report to wallet-report and Wallet::Report,
+    returning all objects that have never been downloaded (in other words,
+    have never been the target of a get command).
+
 wallet 0.11 (2010-03-08)
 
     When deleting an ACL on the server, verify that the ACL is not
diff --git a/TODO b/TODO
index 1e9f3c9..06521cd 100644
--- a/TODO
+++ b/TODO
@@ -137,7 +137,7 @@ Reports:
    previous versions before ACL deletion was checked with database
    backends that don't do referential integrity.
 
- * Add report for all objects that have never been stored or downloaded.
+ * Add report for all objects that have never been stored.
 
  * Add report of all ACLs with identical contents.
 
diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm
index c743060..64418ee 100644
--- a/perl/Wallet/Report.pm
+++ b/perl/Wallet/Report.pm
@@ -20,7 +20,7 @@ use Wallet::Database;
 # This version should be increased on any code change to this module.  Always
 # use two digits for the minor version with a leading zero if necessary so
 # that it will sort properly.
-$VERSION = '0.02';
+$VERSION = '0.03';
 
 ##############################################################################
 # Constructor, destructor, and accessors
@@ -128,6 +128,15 @@ sub objects_acl {
     return ($sql, ($acl->id) x 6);
 }
 
+# Return the SQL statement to find all objects that have been created but
+# have never been retrieved (via get).
+sub objects_unused {
+    my ($self) = @_;
+    my $sql = 'select ob_type, ob_name from objects where ob_downloaded_on
+        is null order by objects.ob_type, objects.ob_name';
+    return ($sql);
+}
+
 # Returns a list of all objects stored in the wallet database in the form of
 # type and name pairs.  On error and for an empty database, the empty list
 # will be returned.  To distinguish between an empty list and an error, call
@@ -144,7 +153,7 @@ sub objects {
     if (!defined $type || $type eq '') {
         ($sql) = $self->objects_all;
     } else {
-        if (@args != 1) {
+        if ($type ne 'unused' && @args != 1) {
             $self->error ("object searches require one argument to search");
         } elsif ($type eq 'type') {
             ($sql, @search) = $self->objects_type (@args);
@@ -154,6 +163,8 @@ sub objects {
             ($sql, @search) = $self->objects_flag (@args);
         } elsif ($type eq 'acl') {
             ($sql, @search) = $self->objects_acl (@args);
+        } elsif ($type eq 'unused') {
+            ($sql) = $self->objects_unused (@args);
         } else {
             $self->error ("do not know search type: $type");
         }
@@ -461,13 +472,14 @@ Returns a list of all objects matching a search type and string in the
 database, or all objects in the database if no search information is
 given.
 
-There are four types of searches currently.  C<type>, with a given type,
+There are five types of searches currently.  C<type>, with a given type,
 will return only those entries where the type matches the given type.
 C<owner>, with a given owner, will only return those objects owned by the
 given ACL name or ID.  C<flag>, with a given flag name, will only return
 those items with a flag set to the given value.  C<acl> operates like
 C<owner>, but will return only those objects that have the given ACL name
-or ID on any of the possible ACL settings, not just owner.
+or ID on any of the possible ACL settings, not just owner.  C<unused> will
+return all entries for which a get command has never been issued.
 
 The return value is a list of references to pairs of type and name.  For
 example, if two objects existed in the database, both of type C<keytab>
diff --git a/perl/t/report.t b/perl/t/report.t
index 1dc69f7..00636db 100755
--- a/perl/t/report.t
+++ b/perl/t/report.t
@@ -7,7 +7,7 @@
 #
 # See LICENSE for licensing terms.
 
-use Test::More tests => 151;
+use Test::More tests => 179;
 
 use Wallet::Admin;
 use Wallet::Report;
@@ -49,6 +49,12 @@ is (scalar (@objects), 1, ' and now there is one object');
 is ($objects[0][0], 'base', ' with the right type');
 is ($objects[0][1], 'service/admin', ' and the right name');
 
+# That object should be unused.
+@objects = $report->objects ('unused');
+is (scalar (@objects), 1, ' and that object is unused');
+is ($objects[0][0], 'base', ' with the right type');
+is ($objects[0][1], 'service/admin', ' and the right name');
+
 # Create another ACL.
 is ($server->acl_create ('first'), 1, 'ACL creation succeeds');
 @acls = $report->acls;
@@ -97,6 +103,14 @@ is (scalar (@lines), 1, ' and there is still owner in the report');
 is ($lines[0][0], 'krb5', ' with the right scheme');
 is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier');
 
+# Both objects should now show as unused.
+@objects = $report->objects ('unused');
+is (scalar (@objects), 2, 'There are now two unused objects');
+is ($objects[0][0], 'base', ' and the first has the right type');
+is ($objects[0][1], 'service/admin', ' and the right name');
+is ($objects[1][0], 'base', ' and the second has the right type');
+is ($objects[1][1], 'service/foo', ' and the right name');
+
 # Change the owner of the second object to an empty ACL.
 is ($server->owner ('base', 'service/foo', 'second'), 1,
     ' and changing the owner to an empty ACL works');
@@ -239,6 +253,41 @@ is (scalar (@lines), 1, 'Searching for ACL naming violations finds one');
 is ($lines[0][0], 3, ' and the first has the right ID');
 is ($lines[0][1], 'second', ' and the right name');
 
+# Set up a file bucket so that we can create an object we can retrieve.
+system ('rm -rf test-files') == 0 or die "cannot remove test-files\n";
+mkdir 'test-files' or die "cannot create test-files: $!\n";
+$Wallet::Config::FILE_BUCKET = 'test-files';
+
+# Create a file object and ensure that it shows up in the unused list.
+is ($server->create ('file', 'test'), 1, 'Creating file:test succeeds');
+is ($server->owner ('file', 'test', 'ADMIN'), 1,
+    ' and setting its owner works');
+@objects = $report->objects ('unused');
+is (scalar (@objects), 4, 'There are now four unused objects');
+is ($objects[0][0], 'base', ' and the first has the right type');
+is ($objects[0][1], 'service/admin', ' and the right name');
+is ($objects[1][0], 'base', ' and the second has the right type');
+is ($objects[1][1], 'service/foo', ' and the right name');
+is ($objects[2][0], 'base', ' and the third has the right type');
+is ($objects[2][1], 'service/null', ' and the right name');
+is ($objects[3][0], 'file', ' and the fourth has the right type');
+is ($objects[3][1], 'test', ' and the right name');
+
+# Store something and retrieve it, and then check that the file object fell
+# off of the list.
+is ($server->store ('file', 'test', 'Some data'), 1,
+    'Storing data in file:test succeeds');
+is ($server->get ('file', 'test'), 'Some data', ' and retrieving it works');
+@objects = $report->objects ('unused');
+is (scalar (@objects), 3, ' and now there are three unused objects');
+is ($objects[0][0], 'base', ' and the first has the right type');
+is ($objects[0][1], 'service/admin', ' and the right name');
+is ($objects[1][0], 'base', ' and the second has the right type');
+is ($objects[1][1], 'service/foo', ' and the right name');
+is ($objects[2][0], 'base', ' and the third has the right type');
+is ($objects[2][1], 'service/null', ' and the right name');
+
 # Clean up.
 $admin->destroy;
 unlink 'wallet-db';
+system ('rm -r test-files') == 0 or die "cannot remove test-files\n";
diff --git a/server/wallet-report b/server/wallet-report
index 435fb73..28d5b9a 100755
--- a/server/wallet-report
+++ b/server/wallet-report
@@ -177,6 +177,8 @@ one line per object or ACL.
 
 =item objects type <type>
 
+=item objects unused
+
 Returns a list of objects in the database.  Objects will be listed in the
 form:
 
@@ -210,6 +212,11 @@ Returns all objects owned by the given ACL name or ID.
 
 Returns all objects of the given type.
 
+=item objects unused
+
+Returns all objects that have never been downloaded (have never been the
+target of a get command).
+
 =back
 
 =item owners <type-pattern> <name-pattern>