SecureHostingUPG.pm

   1 package Business::OnlinePayment::SecureHostingUPG;\r
   2 \r
   3 use strict;\r
   4 use Carp;\r
   5 use Business::OnlinePayment 3;\r
   6 use Business::OnlinePayment::HTTPS;\r
   7 use vars qw($VERSION $DEBUG @ISA);\r
   8 \r
   9 @ISA = qw(Business::OnlinePayment::HTTPS);\r
  10 $VERSION = '0.03';\r
  11 $DEBUG = 0;\r
  12 \r
  13 sub set_defaults {\r
  14         my $self = shift;\r
  15 \r
  16         $self->server('www.secure-server-hosting.com');\r
  17         $self->port('443');\r
  18         $self->path('/secutran/transactionjs1.php');\r
  19 \r
  20         $self->build_subs(qw(\r
  21           order_number avs_code\r
  22                          ));\r
  23         # order_type\r
  24         # md5 cvv2_response cavv_response\r
  25 \r
  26 }\r
  27 \r
  28 sub submit {\r
  29     my($self) = @_;\r
  30 \r
  31     #$self->map_fields();\r
  32     $self->remap_fields(\r
  33         #                => 'order_type',\r
  34         #                => 'transaction_type',\r
  35         login            => 'shreference',\r
  36         password         => 'checkcode',\r
  37         #authorization   => \r
  38         #customer_ip     =>\r
  39         name             => 'cardholdersname',\r
  40         #first_name      =>\r
  41         #last_name       =>\r
  42         #company         =>\r
  43         address          => 'cardholderaddr1',\r
  44         #                => 'cardholderaddr2',\r
  45         city             => 'cardholdercity',\r
  46         state            => 'cardholderstate',\r
  47         zip              => 'cardholderpostcode',\r
  48         #country         =>\r
  49         phone            => 'cardholdertelephonenumber',\r
  50         #fax             =>\r
  51         email            => 'cardholdersemail',\r
  52         card_number      => 'cardnumber',\r
  53         #                => 'cardexpiremonth',\r
  54         #                => 'cardexpireyear',\r
  55 \r
  56         'amount'         => 'transactionamount',\r
  57         #invoice_number  =>\r
  58         #customer_id     =>\r
  59         #order_number    =>\r
  60 \r
  61         currency          => 'transactioncurrency',\r
  62 \r
  63         #expiration        =>\r
  64         cvv2              => 'cv2',\r
  65         issue_number      => 'switchnumber',\r
  66     );\r
  67 \r
  68     die "only Normal Authorization is currently supported"\r
  69       unless $self->{_content}{'action'} =~ /^\s*normal\s*authorization\s*$/i;\r
  70 \r
  71     #cardexpiremonth & cardexpireyear\r
  72     $self->{_content}{'expiration'} =~ /^(\d+)\D+\d*(\d{2})$/\r
  73       or croak "unparsable expiration ". $self->{_content}{expiration};\r
  74     my( $month, $year ) = ( $1, $2 );\r
  75     $month = '0'. $month if $month =~ /^\d$/;\r
  76     $self->{_content}{cardexpiremonth} = $month;\r
  77     $self->{_content}{cardexpireyear} = $year;\r
  78 \r
  79     #cardstartmonth & cardstartyear\r
  80     $self->{_content}{'card_start'} =~ /^(\d+)\D+\d*(\d{2})$/\r
  81       or croak "unparsable card_start ". $self->{_content}{expiration};\r
  82     my( $smonth, $syear ) = ( $1, $2 );\r
  83     $smonth = '0'. $smonth if $smonth =~ /^\d$/;\r
  84     $self->{_content}{cardstartmonth} = $smonth;\r
  85     $self->{_content}{cardstartyear} = $syear;\r
  86 \r
  87     $self->required_fields(qw(\r
  88       shreference checkcode transactionamount transactioncurrency\r
  89       cardexpireyear cardexpiremonth cardstartyear cardstartmonth\r
  90       switchnumber cv2 cardnumber cardholdersname cardholdersemail\r
  91     ));\r
  92 \r
  93     my( $page, $response, @reply_headers) =\r
  94       $self->https_post( $self->get_fields( $self->fields ) );\r
  95     #my( $page, $response, @reply_headers) =\r
  96     #  $self->https_get( $self->get_fields( $self->fields ) );\r
  97 \r
  98     #my %reply_headers = @reply_headers;\r
  99     #warn join('', map { "  $_ => $reply_headers{$_}\n" } keys %reply_headers )\r
 100     #  if $DEBUG;\r
 101 \r
 102     #XXX check $response and die if not 200?\r
 103 \r
 104     #   avs_code\r
 105     #   is_success\r
 106     #   result_code\r
 107     #   authorization\r
 108     #md5 cvv2_response cavv_response ...?\r
 109 \r
 110     $self->server_response($page);\r
 111 \r
 112     my $result = $self->GetXMLProp($page, 'result');\r
 113 \r
 114     if ( defined($result) && $result eq 'success' ) {\r
 115       $self->is_success(1);\r
 116       $self->avs_code( $self->GetXMLProp($page, 'cv2asvresult') );\r
 117     } elsif ( defined($result) && $result eq 'failed' ) {\r
 118       $self->is_success(0);\r
 119       my $error = '';\r
 120       my $tranerrdesc   = $self->GetXMLProp($page, 'tranerrdesc');\r
 121       my $tranerrdetail = $self->GetXMLProp($page, 'tranerrdetail');\r
 122       $error = $tranerrdesc if defined $tranerrdesc;\r
 123       $error .= " - $tranerrdetail"\r
 124         if defined $tranerrdetail && length $tranerrdetail;\r
 125       $self->error_message($error);\r
 126     } else {\r
 127       die "unparsable response received from gateway".\r
 128           ( $DEBUG ? ": $page" : '' );\r
 129     }\r
 130 \r
 131 }\r
 132 \r
 133 \r
 134 sub fields {\r
 135         my $self = shift;\r
 136 \r
 137         qw(\r
 138           shreference\r
 139           checkcode\r
 140           transactionamout\r
 141           transactioncurrency\r
 142           cardexpireyear\r
 143           cardexpiremonth\r
 144           cardstartyear\r
 145           cardstartmonth\r
 146           switchnumber\r
 147           cv2\r
 148           cardnumber\r
 149           cardholdersname\r
 150           cardholdersemail\r
 151           cardholderaddr1\r
 152           cardholderaddr2\r
 153           cardholdercity\r
 154           cardholderstate\r
 155           cardholderpostcode\r
 156           cardholdertelephonenumber\r
 157         );\r
 158 }\r
 159 \r
 160 sub GetXMLProp {\r
 161         my( $self, $raw, $prop ) = @_;\r
 162         local $^W=0;\r
 163 \r
 164         my $data;\r
 165         ($data) = $raw =~ m"<$prop>(.*?)</$prop>"gsi;\r
 166         #$data =~ s/<.*?>/ /gs;\r
 167         chomp $data;\r
 168         return $data;\r
 169 }\r
 170 \r
 171 1;\r
 172 \r
 173 __END__\r
 174 \r
 175 =head1 NAME\r
 176 \r
 177 Business::OnlinePayment::SecureHostingUPG - SecureHosting UPG backend module for Business::OnlinePayment\r
 178 \r
 179 =head1 SYNOPSIS\r
 180 \r
 181   use Business::OnlinePayment;\r
 182 \r
 183   ####\r
 184   # One step transaction, the simple case.\r
 185   ####\r
 186 \r
 187   my $tx = new Business::OnlinePayment("SecureHostingUPG");\r
 188   $tx->content(\r
 189       type           => 'VISA',\r
 190       login          => 'SecureHosting Reference',\r
 191       password       => 'SecureHosting Checkcode value',\r
 192       action         => 'Normal Authorization',\r
 193       description    => 'Business::OnlinePayment test',\r
 194       amount         => '49.95',\r
 195       currency       => 'GBP',\r
 196       name           => 'Tofu Beast',\r
 197       address        => '123 Anystreet',\r
 198       city           => 'Anywhere',\r
 199       state          => 'UT',\r
 200       zip            => '84058',\r
 201       phone          => '420-867-5309',\r
 202       email          => 'tofu.beast@example.com',\r
 203       card_number    => '4005550000000019',\r
 204       expiration     => '08/06',\r
 205       card_start     => '05/04',\r
 206       cvv2           => '1234', #optional\r
 207       issue_number   => '5678',\r
 208   );\r
 209   $tx->submit();\r
 210 \r
 211   if($tx->is_success()) {\r
 212       print "Card processed successfully: ".$tx->authorization."\n";\r
 213   } else {\r
 214       print "Card was rejected: ".$tx->error_message."\n";\r
 215   }\r
 216 \r
 217 =head1 SUPPORTED TRANSACTION TYPES\r
 218 \r
 219 =head2 CC, Visa, MasterCard, American Express, Discover\r
 220 \r
 221 Content required: type, login, password, action, amount, first_name, last_name, card_number, expiration.\r
 222 \r
 223 =head1 PREREQUISITES\r
 224 \r
 225   URI::Escape\r
 226   Tie::IxHash\r
 227 \r
 228   Net::SSLeay _or_ ( Crypt::SSLeay and LWP )\r
 229 \r
 230   The included htmlgood.html and htmlbad.html files must be uploaded to your\r
 231   Secure Hosting account (Settings | File Manager).\r
 232 \r
 233 =head1 DESCRIPTION\r
 234 \r
 235 For detailed information see L<Business::OnlinePayment>.\r
 236 \r
 237 =head1 NOTE\r
 238 \r
 239 Only "Normal Authorization" is supported by the gateway.\r
 240 \r
 241 =head1 AUTHOR\r
 242 \r
 243 Ivan Kohler <ivan-securehostingupg@420.am>\r
 244 \r
 245 =head1 SEE ALSO\r
 246 \r
 247 perl(1). L<Business::OnlinePayment>.\r
 248 \r
 249 =cut\r
 250 \r