Open-ILS/src/perlmods/OpenILS/Application/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::CreditCard;
  19 use base qw/OpenSRF::Application/;
  20 use strict; use warnings;
  21
  22 use Business::CreditCard;
  23 use Business::OnlinePayment;
  24 use Locale::Country;
  25
  26 use OpenILS::Event;
  27 use OpenSRF::Utils::Logger qw/:logger/;
  28 use OpenILS::Utils::CStoreEditor qw/:funcs/;
  29 use OpenILS::Application::AppUtils;
  30 my $U = "OpenILS::Application::AppUtils";
  31
  32 use constant CREDIT_NS => "credit";
  33
  34 # Given the argshash from process_payment(), this helper function just finds
  35 # a function in the current namespace named "bop_args_{processor}" and calls
  36 # it with $argshash as an argument, returning the result, or returning an
  37 # empty hash if it can't find such a function.
  38 sub get_bop_args_filler {
  39     no strict 'refs';
  40
  41     my $argshash = shift;
  42     my $funcname = "bop_args_" . $argshash->{processor};
  43     return &{$funcname}($argshash) if defined &{$funcname};
  44     return ();
  45 }
  46
  47 # Provide default arguments for calls using the AuthorizeNet processor
  48 sub bop_args_AuthorizeNet {
  49     my $argshash = shift;
  50     if ($argshash->{server}) {
  51         return (
  52             # One might provide "test.authorize.net" here.
  53             Server => $argshash->{server},
  54         );
  55     }
  56     else {
  57         return ();
  58     }
  59 }
  60
  61 # Provide default arguments for calls using the PayPal processor
  62 sub bop_args_PayPal {
  63     my $argshash = shift;
  64     return (
  65         Username => $argshash->{login},
  66         Password => $argshash->{password},
  67         Signature => $argshash->{signature}
  68     );
  69 }
  70
  71 sub get_processor_settings {
  72     my $org_unit = shift;
  73     my $processor = lc shift;
  74
  75     +{ map { ($_ =>
  76         $U->ou_ancestor_setting_value(
  77             $org_unit, CREDIT_NS . ".processor.${processor}.${_}"
  78         )) } qw/enabled login password signature server testmode/
  79     };
  80 }
  81
  82 __PACKAGE__->register_method(
  83     method    => 'process_payment',
  84     api_name  => 'open-ils.credit.process',
  85     signature => {
  86         desc   => 'Process a payment via a supported processor (AuthorizeNet, Paypal)',
  87         params => [
  88             { desc => q/Hash of arguments with these keys:
  89                 patron_id: Not a barcode, but a patron's internal ID
  90                        ou: Org unit where transaction happens
  91                 processor: Payment processor to use (AuthorizeNet, PayPal, etc)
  92                        cc: credit card number
  93                      cvv2: 3 or 4 digits from back of card
  94                    amount: transaction value
  95                    action: optional (default: Normal Authorization)
  96                first_name: optional (default: patron's first_given_name field)
  97                 last_name: optional (default: patron's family_name field)
  98                   address: optional (default: patron's street1 field + street2)
  99                      city: optional (default: patron's city field)
 100                     state: optional (default: patron's state field)
 101                       zip: optional (default: patron's zip field)
 102                   country: optional (some processor APIs: 2 letter code.)
 103               description: optional
 104                 /, type => 'hash' }
 105         ],
 106         return => { desc => 'Hash of status information', type =>'hash' }
 107     }
 108 );
 109
 110 sub process_payment {
 111     my ($self, $client, $argshash) = @_; # $client is unused in this sub
 112
 113     # Confirm some required arguments.
 114     return OpenILS::Event->new('BAD_PARAMS')
 115         unless $argshash
 116             and $argshash->{cc}
 117             and $argshash->{amount}
 118             and $argshash->{expiration}
 119             and $argshash->{ou};
 120
 121     if (!$argshash->{processor}) {
 122         if (!($argshash->{processor} =
 123                 $U->ou_ancestor_setting_value(
 124                     $argshash->{ou}, CREDIT_NS . '.processor.default'))) {
 125             return OpenILS::Event->new('CREDIT_PROCESSOR_NOT_SPECIFIED');
 126         }
 127     }
 128     # Basic sanity check on processor name.
 129     if ($argshash->{processor} !~ /^[a-z0-9_\-]+$/i) {
 130         return OpenILS::Event->new('CREDIT_PROCESSOR_NOT_ALLOWED');
 131     }
 132
 133     # Get org unit settings related to our processor
 134     my $psettings = get_processor_settings(
 135         $argshash->{ou}, $argshash->{processor}
 136     );
 137
 138     if (!$psettings->{enabled}) {
 139         return OpenILS::Event->new('CREDIT_PROCESSOR_NOT_ENABLED');
 140     }
 141
 142     # Add the org unit settings for the chosen processor to our argshash.
 143     $argshash = +{ %{$argshash}, %{$psettings} };
 144
 145     # At least the following (derived from org unit settings) are required.
 146     return OpenILS::Event->new('CREDIT_PROCESSOR_BAD_PARAMS')
 147         unless $argshash->{login}
 148             and $argshash->{password};
 149
 150     # A valid patron_id is also required.
 151     my $e = new_editor();
 152     my $patron = $e->retrieve_actor_user(
 153         [
 154             $argshash->{patron_id},
 155             {
 156                 flesh        => 1,
 157                 flesh_fields => { au => ["mailing_address"] }
 158             }
 159         ]
 160     ) or return $e->event;
 161
 162     return dispatch($argshash, $patron);
 163 }
 164
 165 sub prepare_bop_content {
 166     my ($argshash, $patron, $cardtype) = @_;
 167
 168     my %content;
 169     foreach (qw/
 170         login
 171         password
 172         description
 173         first_name
 174         last_name
 175         amount
 176         expiration
 177         cvv2
 178         address
 179         city
 180         state
 181         zip
 182         country/) {
 183         if (exists $argshash->{$_}) {
 184             $content{$_} = $argshash->{$_};
 185         }
 186     }
 187
 188     $content{action}       = $argshash->{action} || "Normal Authorization";
 189     $content{type}         = $cardtype;      #'American Express', 'VISA', 'MasterCard'
 190     $content{card_number}  = $argshash->{cc};
 191     $content{customer_id}  = $patron->id;
 192
 193     $content{first_name} ||= $patron->first_given_name;
 194     $content{last_name}  ||= $patron->family_name;
 195
 196     $content{FirstName}    = $content{first_name};   # kludge mcugly for PP
 197     $content{LastName}     = $content{last_name};
 198
 199
 200     # Especially for the following fields, do we need to support different
 201     # mapping of fields for different payment processors, particularly ones
 202     # in other countries?
 203     $content{address}    ||= $patron->mailing_address->street1;
 204     $content{address} .= ", " . $patron->mailing_address->street2
 205         if $patron->mailing_address->street2;
 206
 207     $content{city}       ||= $patron->mailing_address->city;
 208     $content{state}      ||= $patron->mailing_address->state;
 209     $content{zip}        ||= $patron->mailing_address->post_code;
 210     $content{country}    ||= $patron->mailing_address->country;
 211
 212     # Yet another fantastic kludge. country2code() comes from Locale::Country.
 213     # PayPal must have 2 letter country field (ISO 3166) that's uppercase.
 214     if (length($content{country}) > 2 && $argshash->{processor} eq 'PayPal') {
 215         $content{country} = uc country2code($content{country});
 216     }
 217
 218     %content;
 219 }
 220
 221 sub dispatch {
 222     my ($argshash, $patron) = @_;
 223
 224     # The validate() sub is exported by Business::CreditCard.
 225     if (!validate($argshash->{cc})) {
 226         # Although it might help a troubleshooter, it's probably not a good
 227         # idea to put the credit card number in the log file.
 228         $logger->warn("Credit card number invalid");
 229
 230         # The idea of returning a hashref with statusText and statusCode
 231         # comes from an older version handle_authorizenet(), but I'm not
 232         # sure it's the best thing to do, really.
 233         return {
 234             statusText => "Credit card number invalid",
 235             statusCode => 500
 236         };
 237     }
 238
 239     # cardtype() also comes from Business::CreditCard.  It is not certain that
 240     # a) the card type returned by this method will be suitable input for
 241     #   a payment processor, nor that
 242     # b) it is even necessary to supply this argument to processors in all
 243     #   cases.  Testing this with several processors would be a good idea.
 244     (my $cardtype = cardtype($argshash->{cc})) =~ s/ card//;
 245
 246     $logger->debug(
 247         "applying payment via processor '" . $argshash->{processor} . "'"
 248     );
 249
 250     # Find B:OP constructor arguments specific to our payment processor.
 251     my %bop_args = get_bop_args_filler($argshash);
 252
 253     # We're assuming that all B:OP processors accept this argument to the
 254     # contstructor.
 255     $bop_args{test_transaction} = $argshash->{testmode};
 256
 257     my $transaction = new Business::OnlinePayment(
 258         $argshash->{processor}, %bop_args
 259     );
 260
 261     $transaction->content(prepare_bop_content($argshash, $patron, $cardtype));
 262     $transaction->submit();
 263
 264     # The data structures that we return based on success or failure are still
 265     # basically from earlier code.  These might should be improved/reduced.
 266     if ($transaction->is_success()) {
 267         $logger->info($argshash->{processor} . " payment succeeded");
 268
 269         my $retval = {
 270             statusText => "Transaction approved: " . $transaction->authorization,
 271             processor => $argshash->{processor},
 272             cardType => $cardtype,
 273             statusCode => 200,
 274             approvalCode => $transaction->authorization,
 275             server_response => $transaction->server_response
 276         };
 277
 278         # These result fields may be important in PayPal xactions? Not sure.
 279         foreach (qw/correlationid avs_code cvv2_code/) {
 280             if ($transaction->can($_)) {
 281                 $retval->{$_} = $transaction->$_;
 282             }
 283         }
 284         return $retval;
 285     }
 286     else {
 287         $logger->info($argshash->{processor} . " payment failed");
 288         return {
 289             statusText => "Transaction declined: " . $transaction->error_message,
 290             statusCode => 500,
 291             errorMessage => $transaction->error_message,
 292             server_response => $transaction->server_response
 293         };
 294     }
 295
 296 }
 297
 298
 299 1;