Implement ability to put requests on hold.

Requests can now be placed "on hold", and getRequest() can ignore held
requests.

This required addition of a table, and another API call holdRequest().

Tests were not written here, which was a mistake.  Unit tests and docs
are needed.  A FIXME was added, at least.

Also, minor imporvements to reporting on fulfilled requests.

Supporters/lib/Supporters.pm

@@ -942,6 +942,7 @@ sub addRequestConfigurations($$$) {
   $self->_commit();
   return { $requestId => \%descriptions };
 }
+my $TODAY = UnixDate(ParseDate("today"), '%Y-%m-%d');
 ######################################################################
 
 =begin getRequest
@@ -1038,14 +1039,37 @@ If the request has been fufilled, the following keys will also have values:
 
 =back
 
+If the request is on hold, the following keys will also have values:
+
+=over
+
+=item holdReleaseDate
+
+      The date the request will be held until, in ISO 8601 format.
+
+=item holdDate
+
+      The date the hold was requested, in ISO 8601 format.
+
+=item holder
+
+      The person who is holding the request
+
+=item heldBecause
+
+      Why the person is holding the request.
+
+=back
+
 =back
 
 =cut
 
 sub getRequest($$;$) {
   my($self, $params) = @_;
-  my($donorId, $requestType, $requestTypeId, $ignoreFulfilledRequests) =
+  my($donorId, $requestType, $requestTypeId, $ignoreFulfilledRequests, $ignoreHeldRequests) =
-    ($params->{donorId}, $params->{requestType}, $params->{requestTypeId}, $params->{ignoreFulfilledRequests});
+    ($params->{donorId}, $params->{requestType}, $params->{requestTypeId}, $params->{ignoreFulfilledRequests},
+     $params->{ignoreHeldRequests});
 
   die "getRequest: undefined donorId" unless defined $donorId;
   die "getRequest: donorId, \"$donorId\" not found in supporter database"
@@ -1091,12 +1115,25 @@ sub getRequest($$;$) {
       "not valid for requestId, \"$requestId\"") unless defined $configName or (keys %{$configs->{$requestId}} == 0);
   $rsp->{requestConfiguration} = $configName;
 
-  my $fulfillReq = $self->dbh()->selectall_hashref("SELECT id, request_id, date FROM fulfillment WHERE request_id = " .
+  my $fulfillReq = $self->dbh()->selectall_hashref("SELECT id, request_id, date, who, how FROM fulfillment WHERE request_id = " .
                                                    $self->dbh->quote($requestId, 'SQL_INTEGER'),
                                                    'request_id');
   if (defined $fulfillReq and defined $fulfillReq->{$requestId} and defined $fulfillReq->{$requestId}{id}) {
     return undef if $ignoreFulfilledRequests;
     $rsp->{fulfillDate} = $fulfillReq->{$requestId}{date};
+    $rsp->{fulfilledBy} = $fulfillReq->{$requestId}{who};
+    $rsp->{fulfilledVia} = $fulfillReq->{$requestId}{how};
+  }
+  my $holdReq = $self->dbh()->selectall_hashref("SELECT id, request_id, hold_date, release_date, who, why " .
+                                                "FROM request_hold WHERE request_id = " .
+                                                   $self->dbh->quote($requestId, 'SQL_INTEGER'),
+                                                   'request_id');
+  if (defined $holdReq and defined $holdReq->{$requestId} and defined $holdReq->{$requestId}{id}) {
+    return undef if $ignoreHeldRequests and ($TODAY le $holdReq->{$requestId}{release_date});
+    $rsp->{holdDate} = $holdReq->{$requestId}{hold_date};
+    $rsp->{releaseDate} = $holdReq->{$requestId}{release_date};
+    $rsp->{holder} = $holdReq->{$requestId}{who};
+    $rsp->{heldBecause} = $holdReq->{$requestId}{why};
   }
   return $rsp;
 }
@@ -1266,6 +1303,49 @@ sub fulfillRequest($$) {
 
 ######################################################################
 
+=begin holdRequest
+
+FIXME: docs
+
+=cut
+
+sub holdRequest($$) {
+  my($self, $params) = @_;
+  die "holdRequest: undefined donorId" unless defined $params->{donorId};
+  my $donorId = $params->{donorId};
+  die "holdRequest: donorId, \"$donorId\" not found in supporter database"
+    unless $self->_verifyId($donorId);
+  foreach my $key (qw/who holdReleaseDate heldBecause/) {
+    die "holdRequest: required parameter undefined: \"$key\"" unless defined $params->{$key};
+  }
+  die "holdRequest: requestType, requestTypeId, and requestId are all undefined"
+    unless defined $params->{requestType} or defined $params->{requestTypeId};
+
+  my $req = $self->getRequest($params);
+  return undef if not defined $req;
+  my $requestId = $req->{requestId};
+  return undef if not defined $requestId;
+
+  my $holdLookupSql = "SELECT id, request_id FROM request_hold WHERE request_id = " .
+                        $self->dbh->quote($requestId, 'SQL_INTEGER');
+
+  my $holdRecord = $self->dbh()->selectall_hashref($holdLookupSql, "request_id");
+  if (not defined $holdRecord or not defined $holdRecord->{$requestId}) {
+    $self->_beginWork;
+    my $sth = $self->dbh->prepare("INSERT INTO " .
+                                  "request_hold(request_id, who, why, release_date, hold_date) " .
+                                        "VALUES(?,           ?,   ?  , ?  ,         date('now'))");
+
+    $sth->execute($requestId, $params->{who}, $params->{heldBecause}, $params->{releaseDate});
+    $sth->finish;
+    $self->_commit;
+    $holdRecord = $self->dbh()->selectall_hashref($holdLookupSql, "request_id");
+  }
+  return $holdRecord->{$requestId}{id};
+}
+
+######################################################################
+
 =begin findDonor
 
 Arguments:

Supporters/t/Supporters.t

@@ -4,7 +4,7 @@
 # License: AGPLv3-or-later
 #  Copyright info in COPYRIGHT.md, License details in LICENSE.md with this package.
 ###############################################################################
-
+# FIXME: Untested things: request holds.
 use strict;
 use warnings;
 

scripts/find-supporter.plx

@@ -76,8 +76,17 @@ foreach my $id (@supporterIds) {
         print "\n";
       } else {
         print "...\n          fulfilled on $req->{fulfillDate}";
-        print "...\n          notes: $req->{notes}" if defined $req->{notes};
+        print "...\n              by: $req->{fulfilledBy}" if defined $req->{fulfilledBy};
+        print "...\n             via: $req->{fulfilledVia}" if defined $req->{fulfilledVia};
+      }
+      if (not defined $req->{holdDate}  ) {
         print "\n";
+      } else {
+        print "...\n          put on hold on  $req->{holdDate} by $req->{holder}";
+        print "...\n              release on: $req->{holdReleaseDate}\n" if defined $req->{holdRelaseDate};
+        print "...\n              on hold because: $req->{heldBecause}\n" if defined $req->{heldBecause};
+
+
       }
     }
   }

scripts/hold-request.plx

@@ -0,0 +1,74 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use DBI;
+use Encode qw(encode decode);
+use Supporters;
+
+if (@ARGV != 1 and @ARGV !=2) {
+  print STDERR "usage: $0 <SUPPORTERS_SQLITE_DB_FILE> <VERBOSITY_LEVEL>\n";
+  exit 1;
+}
+
+my($SUPPORTERS_SQLITE_DB_FILE, $VERBOSE) = @ARGV;
+$VERBOSE = 0 if not defined $VERBOSE;
+
+my $dbh = DBI->connect("dbi:SQLite:dbname=$SUPPORTERS_SQLITE_DB_FILE", "", "",
+                               { RaiseError => 1, sqlite_unicode => 1 })
+  or die $DBI::errstr;
+
+my $sp = new Supporters($dbh, [ "none" ]);
+
+print "Supporter Id: ";
+my $supporterId = <STDIN>;
+chomp $supporterId;
+
+my @requestTypes = $sp->getRequestType();
+my %requestTypes;
+@requestTypes{@requestTypes} = @requestTypes;
+my $requestType = "";
+while (not defined $requestTypes{$requestType}) {
+  print "Request Type (", join(", ", @requestTypes), "): ";
+  $requestType = <STDIN>;
+  chomp $requestType;
+}
+print "Why Request held: ";
+my $why = <STDIN>;
+chomp $why;
+
+print "Who held: ";
+my $who = <STDIN>;
+chomp $who;
+
+my $heldUntil;
+while (not defined $heldUntil) {
+  print "Hold when Until What date (ISO 8601 format): ";
+  $heldUntil = <STDIN>;
+  chomp $heldUntil;
+  $heldUntil = undef unless $heldUntil =~ /^\d{4,4}-\d{2,2}-\d{2,2}$/;
+}
+
+my $req = $sp->getRequest({ donorId => $supporterId, requestType => $requestType});
+if (defined $req) {
+  print "Request $req->{requestType}";
+  print "($req->{requestConfiguration})" if defined $req->{requestConfiguration};
+  print " made on $req->{requestDate}";
+}
+print "Using request id, $req->{requestId}\n";
+if (defined $req->{holdDate}) {
+  print "That request is already on hold:\n";
+  print "...\n          put on hold on  $req->{holdDate} by $req->{holder}";
+  print "...\n              release on: $req->{holdReleaseDate}\n" if defined $req->{holdRelaseDate};
+  print "...\n              on hold because: $req->{heldBecause}\n" if defined $req->{heldBecause};
+  exit 1;
+}
+
+my $id = $sp->holdRequest({donorId => $supporterId, requestType => $req->{requestType},
+                           who => $who, heldBecause => $why,
+                           holdReleaseDate => $heldUntil});
+
+
+die "error: unable to hold hold request" unless defined $id;
+print "Request held.  Hold Id is $id\n";

scripts/send-t-shirts.plx

@@ -42,8 +42,11 @@ close TEX_FILE;
 
 foreach my $id (sort keys %idsSent) {
   my $request;
-  foreach my $type (qw/t-shirt-0 t-shirt-1/) {
+  my @requestTypes = $sp->getRequestType();
-    $request = $sp->getRequest({ donorId => $id, requestType => $type, ignoreFulfilledRequests => 1 });
+  foreach my $type (@requestTypes) {
+    next unless if ($type =~ /t-shirt/);
+    $request = $sp->getRequest({ donorId => $id, requestType => $type,
+                                 ignoreHeldRequests => 1, ignoreFulfilledRequests => 1 });
     if (defined $request and defined $request->{requestType}) {
       if ($request->{requestConfiguration} ne $idsSent{$id}) {
         my $out = "WARNING: not fufilling $id request for $request->{requstConfiguration} because we sent wrong size of $idsSent{$id}!\n";

scripts/t-shirt-label-print.plx

@@ -80,7 +80,8 @@ sub sortFunction($$) {
 foreach my $id (sort { sortFunction($a, $b); } @supporterIds) {
   my $sizeNeeded;
   foreach my $type (qw/t-shirt-0 t-shirt-1/) {
-    my $request = $sp->getRequest({ donorId => $id, requestType => $type, ignoreFulfilledRequests => 1 });
+    my $request = $sp->getRequest({ donorId => $id, requestType => $type,
+                                    ignoreHeldRequests => 1, ignoreFulfilledRequests => 1 });
     if (defined $request and defined $request->{requestType}) {
       $sizeNeeded = $request->{requestConfiguration};
       last;

sql/supporters-schema.sql

@@ -47,6 +47,19 @@ CREATE TABLE "fulfillment" (
 
 CREATE UNIQUE INDEX fulfillment__one_fulfillment_per_request ON fulfillment(request_id);
 
+DROP TABLE IF EXISTS "request_hold";
+
+CREATE TABLE "request_hold" (
+    "id" integer NOT NULL PRIMARY KEY,
+    "request_id" integer NOT NULL,
+    "hold_date" TEXT NOT NULL,
+    "release_date" TEXT,
+    "who" varchar(300) NOT NULL,
+    "why" TEXT
+);
+
+CREATE UNIQUE INDEX request_hold__one_hold_per_request ON request_hold(request_id);
+
 DROP TABLE IF EXISTS "request_type";
 
 CREATE TABLE "request_type" (