From 26c7e938ff71db3ef84640c91c1d6b96ac1937cd Mon Sep 17 00:00:00 2001
From: "Bradley M. Kuhn" <bkuhn@ebb.org>
Date: Fri, 9 Dec 2016 13:44:08 -0800
Subject: [PATCH] fulfillFailure: turn fulfill into hold.

if we are unable to fulfill a request, this method turns it into an
indefinite hold on the request.

This design model for handling failure in fulfillment may not be the
best one, but it seemed to roughly fit the behavior and data model we're
looking for.

A little information is lost, but is at least saved in the 'why' field
of the request_hold table.
---
 Supporters/lib/Supporters.pm | 56 ++++++++++++++++++++++++++++++++++++
 Supporters/t/Supporters.t    |  2 +-
 scripts/fulfill-failed.plx   | 45 +++++++++++++++++++++++++++++
 3 files changed, 102 insertions(+), 1 deletion(-)
 create mode 100644 scripts/fulfill-failed.plx

diff --git a/Supporters/lib/Supporters.pm b/Supporters/lib/Supporters.pm
index 0d2611f..54c55d9 100644
--- a/Supporters/lib/Supporters.pm
+++ b/Supporters/lib/Supporters.pm
@@ -1303,6 +1303,62 @@ sub fulfillRequest($$) {
 
 ######################################################################
 
+=begin fulfillFailure
+
+FIXME better docs
+
+Convert a requests  fulfillment to a mere hold becuase a fulfillment failed.
+
+=cut
+
+sub fulfillFailure($$) {
+  my($self, $params) = @_;
+  die "fulfillFailure: undefined donorId" unless defined $params->{donorId};
+  my $donorId = $params->{donorId};
+  die "fulfillFailure: donorId, \"$donorId\" not found in supporter database"
+    unless $self->_verifyId($donorId);
+  die "fulfillFailure: both why required"
+    unless defined $params->{why};
+  die "fulfillFailure: both requestType and requestTypeId 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 $fulfillLookupSql = "SELECT id, request_id, date, who, how FROM fulfillment WHERE request_id = " .
+                        $self->dbh->quote($requestId, 'SQL_INTEGER');
+
+  my $fulfillRecord = $self->dbh()->selectall_hashref($fulfillLookupSql, "request_id");
+
+  return undef
+    if (not defined $fulfillRecord or not defined $fulfillRecord->{$requestId});
+
+  $self->_beginWork;
+
+  my $reason = "because $params->{why}, fulfillment failed on " . $fulfillRecord->{$requestId}{date} . " (which was attempted via " .
+    $fulfillRecord->{$requestId}{how} . ')';
+
+  my $holdId = $self->holdRequest({donorId => $donorId, requestType => $req->{requestType},
+                                   who => $fulfillRecord->{$requestId}{who},
+                                   heldBecause => $reason, holdReleaseDate => '9999-12-31'});
+
+  die "fulfillFailure: failed to create hold request for fulfillment" unless defined $holdId;
+
+  my $sth = $self->dbh->prepare("UPDATE request_hold SET hold_date = ?  WHERE id = ?");
+  $sth->execute($fulfillRecord->{$requestId}{date}, $holdId);
+  $sth->finish;
+
+  $sth = $self->dbh->prepare("DELETE FROM fulfillment WHERE id = ?");
+  $sth->execute($fulfillRecord->{$requestId}{id});
+  $sth->finish;
+
+  $self->_commit;
+  return $holdId;
+}
+######################################################################
+
 =begin holdRequest
 
 FIXME: docs
diff --git a/Supporters/t/Supporters.t b/Supporters/t/Supporters.t
index 08de05e..d27e895 100644
--- a/Supporters/t/Supporters.t
+++ b/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.
+# FIXME: Untested things: request holds, and fulfill failure
 use strict;
 use warnings;
 
diff --git a/scripts/fulfill-failed.plx b/scripts/fulfill-failed.plx
new file mode 100644
index 0000000..49dc8da
--- /dev/null
+++ b/scripts/fulfill-failed.plx
@@ -0,0 +1,45 @@
+#!/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 fulfillment failed: ";
+my $why = <STDIN>;
+chomp $why;
+
+my $id = $sp->fulfillFailure({donorId => $supporterId, requestType => $requestType, why => $why});
+
+die "requestType $requestType not found for $supporterId, or the request was not already fulfilled yet anyway." unless defined $id;
+
+print "Fulfill failure recorded.  Hold Id is $id\n";