Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/CreditCard.pm

   1 # --------------------------------------------------------------------
   2 # Copyright (C) 2008 Niles Ingalls
   3 # Niles Ingalls <nilesi@zionsville.lib.in.us>
   4 # Bill Erickson <erickson@esilibrary.com>
   5 # Joe Atzberger <jatzberger@esilibrary.com>
   6 # Lebbeous Fogle-Weekley <lebbeous@esilibrary.com>
   7 #
   8 # This program is free software; you can redistribute it and/or
   9 # modify it under the terms of the GNU General Public License
  10 # as published by the Free Software Foundation; either version 2
  11 # of the License, or (at your option) any later version.
  12 #
  13 # This program is distributed in the hope that it will be useful,
  14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 # GNU General Public License for more details.
  17 # --------------------------------------------------------------------
  18 package OpenILS::Application::Circ::CreditCard;
  19 use base qw/OpenSRF::Application/;
  20 use strict; use warnings;
  21
  22 use Business::CreditCard;
  23 use Business::OnlinePayment;
  24 use UUID::Tiny qw/:std/;
  25 use Locale::Country;
  26
  27 use OpenILS::Event;
  28 use OpenSRF::Utils::Logger qw/:logger/;
  29 use OpenILS::Utils::CStoreEditor qw/:funcs/;
  30 use OpenILS::Application::AppUtils;
  31 my $U = "OpenILS::Application::AppUtils";
  32
  33 # Given the argshash from process_payment(), this helper function just finds
  34 # a function in the current namespace named "bop_args_{processor}" and calls
  35 # it with $argshash as an argument, returning the result, or returning an
  36 # empty hash if it can't find such a function.
  37 sub get_bop_args_filler {
  38     no strict 'refs';
  39
  40     my $argshash = shift;
  41     my $funcname = "bop_args_" . $argshash->{processor};
  42     return &{$funcname}($argshash) if defined &{$funcname};
  43     return ();
  44 }
  45
  46 # Provide default arguments for calls using the AuthorizeNet processor
  47 sub bop_args_AuthorizeNet {
  48     my $argshash = shift;
  49     if ($argshash->{server}) {
  50         return (
  51             # One might provide "test.authorize.net" here.
  52             Server => $argshash->{server},
  53         );
  54     }
  55     else {
  56         return ();
  57     }
  58 }
  59
  60 # Provide default arguments for calls using the PayPal processor
  61 sub bop_args_PayPal {
  62     my $argshash = shift;
  63     return (
  64         Username => $argshash->{login},
  65         Password => $argshash->{password},
  66         Signature => $argshash->{signature}
  67     );
  68 }
  69
  70 # Provide default arguments for calls using the PayflowPro processor
  71 sub bop_args_PayflowPro {
  72     my $argshash = shift;
  73     return (
  74         "vendor" => $argshash->{vendor},
  75         "partner" => $argshash->{partner} || "PayPal" # reasonable default?
  76     );
  77 }
  78
  79 #        argshash (Hash of arguments with these keys):
  80 #                patron_id: Not a barcode, but a patron's internal ID
  81 #                       ou: Org unit where transaction happens
  82 #                processor: Payment processor to use
  83 #                           (AuthorizeNet/PayPal/PayflowPro)
  84 #                       cc: credit card number
  85 #                     cvv2: 3 or 4 digits from back of card
  86 #                   amount: transaction value
  87 #                   action: optional (default: Normal Authorization)
  88 #               first_name: optional (default: patron's first_given_name field)
  89 #                last_name: optional (default: patron's family_name field)
  90 #                  address: optional (default: patron's street1 field + street2)
  91 #                     city: optional (default: patron's city field)
  92 #                    state: optional (default: patron's state field)
  93 #                      zip: optional (default: patron's zip field)
  94 #                  country: optional (some processor APIs: 2 letter code.)
  95 #              description: optional
  96
  97 sub process_payment {
  98     my ($argshash) = @_;
  99
 100     # Confirm some required arguments.
 101     return OpenILS::Event->new('BAD_PARAMS')
 102         unless $argshash
 103             and $argshash->{cc}
 104             and $argshash->{amount}
 105             and $argshash->{expiration}
 106             and $argshash->{ou};
 107
 108     # Used to test argshash->{processor} here, but now that's handled earlier.
 109
 110     # At least the following (derived from org unit settings) are required.
 111     return OpenILS::Event->new('CREDIT_PROCESSOR_BAD_PARAMS')
 112         unless $argshash->{login}
 113             and $argshash->{password};
 114
 115     # A valid patron_id is also required.
 116     my $e = new_editor();
 117     my $patron = $e->retrieve_actor_user(
 118         [
 119             $argshash->{patron_id},
 120             {
 121                 flesh        => 1,
 122                 flesh_fields => { au =>
 123                     ["mailing_address", "billing_address", "card"] }
 124             }
 125         ]
 126     ) or return $e->event;
 127
 128     return dispatch($argshash, $patron);
 129 }
 130
 131 sub prepare_bop_content {
 132     my ($argshash, $patron, $cardtype) = @_;
 133
 134     my %content;
 135     foreach (qw/
 136         login
 137         password
 138         description
 139         first_name
 140         last_name
 141         amount
 142         expiration
 143         cvv2
 144         address
 145         city
 146         state
 147         zip
 148         country/) {
 149         if (exists $argshash->{$_}) {
 150             $content{$_} = $argshash->{$_};
 151         }
 152     }
 153
 154     $content{action}       = $argshash->{action} || "Normal Authorization";
 155     $content{type}         = $cardtype;      #'American Express', 'VISA', 'MasterCard'
 156     $content{card_number}  = $argshash->{cc};
 157     $content{customer_id}  = $patron->id;
 158
 159     $content{first_name} ||= $patron->first_given_name;
 160     $content{last_name}  ||= $patron->family_name;
 161
 162     $content{FirstName}    = $content{first_name};   # kludge mcugly for PP
 163     $content{LastName}     = $content{last_name};
 164
 165     # makes patron barcode accessible in CC payment records
 166     my $bc = ($patron->card) ? $patron->card->barcode : '';
 167     $content{description}  = "$bc " . ($content{description} || '');
 168
 169     my $addr = $patron->mailing_address || $patron->billing_address;
 170
 171     if (!$addr) {
 172         # patron has no linked addresses.  See if we have enough data
 173         # provided and/or from settings to complete the transaction
 174
 175         return () unless $content{address} and
 176             $content{city} and $content{state} and $content{zip};
 177
 178         if (!$content{country}) {
 179             # Assume if all other fields are set, that the patron's
 180             # country is the same as their home org unit.
 181
 182             $content{country} = $U->ou_ancestor_setting_value(
 183                $patron->home_ou, 'ui.patron.default_country');
 184
 185             return () unless $content{country}; # time to renew passport
 186         }
 187     }
 188
 189     # Especially for the following fields, do we need to support different
 190     # mapping of fields for different payment processors, particularly ones
 191     # in other countries?
 192     if(!$content{address}) {
 193         $content{address}  = $addr->street1;
 194         $content{address} .= ", " . $addr->street2 if $addr->street2;
 195     }
 196
 197     $content{city}      ||= $addr->city;
 198     $content{state}     ||= $addr->state;
 199     $content{zip}       ||= $addr->post_code;
 200     $content{country}   ||= $addr->country;
 201
 202     # Yet another fantastic kludge. country2code() comes from Locale::Country.
 203     # PayPal must have 2 letter country field (ISO 3166) that's uppercase.
 204     if (length($content{country}) > 2 && $argshash->{processor} eq 'PayPal') {
 205         $content{country} = uc country2code($content{country});
 206     } elsif($argshash->{processor} eq "PayflowPro") {
 207         ($content{request_id} = create_uuid_as_string(UUID_V4)) =~ s/-//;
 208     }
 209
 210     %content;
 211 }
 212
 213 sub dispatch {
 214     my ($argshash, $patron) = @_;
 215
 216     # The validate() sub is exported by Business::CreditCard.
 217     if (!validate($argshash->{cc})) {
 218         # Although it might help a troubleshooter, it's probably not a good
 219         # idea to put the credit card number in the log file.
 220         $logger->info("Credit card number invalid");
 221
 222         return new OpenILS::Event("CREDIT_PROCESSOR_INVALID_CC_NUMBER");
 223     }
 224
 225     # cardtype() also comes from Business::CreditCard.  It is not certain that
 226     # a) the card type returned by this method will be suitable input for
 227     #   a payment processor, nor that
 228     # b) it is even necessary to supply this argument to processors in all
 229     #   cases.  Testing this with several processors would be a good idea.
 230     (my $cardtype = cardtype($argshash->{cc})) =~ s/ card//i;
 231
 232     if (lc($cardtype) eq "unknown") {
 233         $logger->info("Credit card number passed validate(), " .
 234             "yet cardtype() returned $cardtype");
 235         return new OpenILS::Event(
 236             "CREDIT_PROCESSOR_INVALID_CC_NUMBER", "note" => "cardtype $cardtype"
 237         );
 238     }
 239
 240     $logger->debug(
 241         "applying payment via processor '" . $argshash->{processor} . "'"
 242     );
 243
 244     # Find B:OP constructor arguments specific to our payment processor.
 245     my %bop_args = get_bop_args_filler($argshash);
 246
 247     # We're assuming that all B:OP processors accept this argument to the
 248     # constructor.
 249     $bop_args{test_transaction} = $argshash->{testmode};
 250
 251     my $transaction = new Business::OnlinePayment(
 252         $argshash->{processor}, %bop_args
 253     );
 254
 255     my %content = prepare_bop_content($argshash, $patron, $cardtype);
 256
 257     return OpenILS::Event->new(
 258         'CREDIT_PROCESSOR_BAD_PARAMS', note => "Missing address fields")
 259         if keys(%content) == 0;
 260
 261     $transaction->content(%content);
 262
 263     # submit() does not return a value, although crashing is possible here
 264     # with some bad input depending on the payment processor.
 265     $transaction->submit;
 266
 267     my $payload = {
 268         "processor" => $argshash->{"processor"}, "card_type" => $cardtype
 269     };
 270
 271     # Put the values of any of these fields into the event payload, if present.
 272     foreach (qw/authorization correlationid avs_code request_id
 273         server_response cvv2_response cvv2_code error_message order_number/) {
 274         $payload->{$_} = $transaction->$_ if $transaction->can($_);
 275     }
 276
 277     my $event_name;
 278
 279     if ($transaction->is_success) {
 280         $logger->info($argshash->{processor} . " payment succeeded");
 281         $event_name = "SUCCESS";
 282     } else {
 283         $logger->info($argshash->{processor} . " payment failed");
 284         $event_name = "CREDIT_PROCESSOR_DECLINED_TRANSACTION";
 285     }
 286
 287     return new OpenILS::Event($event_name, "payload" => $payload);
 288 }
 289
 290
 291 1;