package II5117351e1a4f1d07d1c88690b7a75168::mod_setcom; use strict; use LWP::UserAgent; sub checkPGateSettings { my $class = shift; my $settings = shift; my @errors; push @errors, 'check.empty_settings' unless $settings->{mid} && $settings->{username} && $settings->{password}; eval { local $SIG{__DIE__} = 'DEFAULT'; require Crypt::SSLeay; }; push @errors, ['check.no_ssl', 'Crypt::SSLeay'] if $@; @errors; } sub checkProductSettings { my $class = shift; my ($product) = @_; my @errors; @errors; } sub go { my $class = shift; my $pgtxn = shift; my $settings = $pgtxn->getPGateSettings; my $order = $pgtxn->getOrder; my $url = "https://www.setcom.com/secure/"; my $jin_pgtxn = ref($pgtxn) . '/' . $pgtxn->id; my $form = { ButtonAction => "checkout", MerchantIdentifier => "$settings->{mid}", CurrencyAlphaCode => $pgtxn->getCurrencyCode, MerchCustom => $jin_pgtxn, LIDSKU => $pgtxn->getInvoiceNumber, LIDDesc => $pgtxn->getDescription, LIDPrice => $pgtxn->getAmount, LIDQty => 1, ShippingRequired => 0, BuyerInformation => "1", FirstName => "$order->{user_fname}", LastName => "$order->{user_lname}", Address1 => "$order->{user_address}", City => "$order->{user_city}", State => "$order->{user_state}", PostalCode => "$order->{user_zipcode}", Country => "$order->{user_country}", Email => "$order->{user_email}", HomeNumber => "$order->{user_phone}", }; $pgtxn->logg('REQ', $form); Zen->getRequest->redirectPOST($url, $form); } sub feedbackReturnPgo { my $class = shift; my $pgate = shift; my $in = Zen->getRequest->getInput; my $settings = $pgate->getView->{SettingsUnpacked}; my $sdata = { checksum => $in->{checksum}, parity => $in->{parity}, tnxid => $in->{tnxid}, Identifier => $settings->{mid}, Usrname => $settings->{username}, Pwd => $settings->{password}, Method => 'tnx_synchro', }; my $ua = LWP::UserAgent->new; $ua->timeout(10); $ua->env_proxy; my $synchrourl = 'https://www.setcom.com/secure/components/synchro.cfc?wsdl'; my $response = $ua->post($synchrourl, $sdata); II720d6e18aa34327713eb014408fc9144::lIIlIIIIllIllIIl($II982446f8950cc3dc59e487adba22df54::lllllllIIlllIIIl{$II8dae0e141ee45f5daba6a74e4a7c3b6f::IllIIlIlIlIlIIIl},130,$II982446f8950cc3dc59e487adba22df54::lllllllIIlllIIIl{$II8dae0e141ee45f5daba6a74e4a7c3b6f::IllIllIlllllllII})->true($response->is_success, "error occured when trying to confirm transaction: " . $response->status_line); my ($jin_pgtxn, $status, $txn_code, $amount); my $dataWddx = $response->content; my $dataXml; $dataWddx =~ s!<char\s+?code='(\w+)'/>!chr(hex("$1"))!esg; if ($dataWddx =~ m!<wddxPacket version='1.0'><header/><data><string>(.+)</string></data></wddxPacket>!s) { $dataXml = _decode_entities($1); ($jin_pgtxn) = $dataXml =~ m!<member>.*?<reference>([^<]+?)</reference>.*?</member>!s; ($status) = $dataXml =~ m!<outcome>.*?<status>(\w+?)</status>.*?</outcome>!s; ($txn_code) = $dataXml =~ m!<outcome>.*?<transaction_id>(\S+?)</transaction_id>.*?</outcome>!s; ($amount) = $dataXml =~ m!<financial>.*?<amount_total>(\w+?)</amount_total>.*?</financial>!s; } II720d6e18aa34327713eb014408fc9144::lIIlIIIIllIllIIl($II720d6e18aa34327713eb014408fc9144::lIIllllIllIlIIlI{$II982446f8950cc3dc59e487adba22df54::lIIlIlIlllIIllIl},130,$II720d6e18aa34327713eb014408fc9144::lIIllllIllIlIIlI{$II8dae0e141ee45f5daba6a74e4a7c3b6f::IlIlllllIllIIlIl})->true($jin_pgtxn, "failed to parse synchro data:<br>$dataWddx"); my ($pgtxn_class, $pgtxn_id) = split '/', $jin_pgtxn; my $pgtxn = $pgtxn_class->get($pgtxn_id); $pgtxn->checkValidForRequest; $pgtxn->logg('RET', $dataXml); my $paymentGood = $status eq 'Complete'; $pgtxn->txnPayment($txn_code) if $paymentGood; $pgtxn->redirectToReturnPage; } sub _decode_entities { my $string = shift; my %entity2char = ( amp    => '&',  # ampersand 
'gt'    => '>',  # greater than
'lt'    => '<',  # less than
quot   => '"',  # double quote apos   => "'",  # single quote AElig	=> chr(198),  # capital AE diphthong (ligature) Aacute	=> chr(193),  # capital A, acute accent Acirc	=> chr(194),  # capital A, circumflex accent Agrave	=> chr(192),  # capital A, grave accent Aring	=> chr(197),  # capital A, ring Atilde	=> chr(195),  # capital A, tilde Auml	=> chr(196),  # capital A, dieresis or umlaut mark Ccedil	=> chr(199),  # capital C, cedilla ETH	=> chr(208),  # capital Eth, Icelandic Eacute	=> chr(201),  # capital E, acute accent Ecirc	=> chr(202),  # capital E, circumflex accent Egrave	=> chr(200),  # capital E, grave accent Euml	=> chr(203),  # capital E, dieresis or umlaut mark Iacute	=> chr(205),  # capital I, acute accent Icirc	=> chr(206),  # capital I, circumflex accent Igrave	=> chr(204),  # capital I, grave accent Iuml	=> chr(207),  # capital I, dieresis or umlaut mark Ntilde	=> chr(209),  # capital N, tilde Oacute	=> chr(211),  # capital O, acute accent Ocirc	=> chr(212),  # capital O, circumflex accent Ograve	=> chr(210),  # capital O, grave accent Oslash	=> chr(216),  # capital O, slash Otilde	=> chr(213),  # capital O, tilde Ouml	=> chr(214),  # capital O, dieresis or umlaut mark THORN	=> chr(222),  # capital THORN, Icelandic Uacute	=> chr(218),  # capital U, acute accent Ucirc	=> chr(219),  # capital U, circumflex accent Ugrave	=> chr(217),  # capital U, grave accent Uuml	=> chr(220),  # capital U, dieresis or umlaut mark Yacute	=> chr(221),  # capital Y, acute accent aacute	=> chr(225),  # small a, acute accent acirc	=> chr(226),  # small a, circumflex accent aelig	=> chr(230),  # small ae diphthong (ligature) agrave	=> chr(224),  # small a, grave accent aring	=> chr(229),  # small a, ring atilde	=> chr(227),  # small a, tilde auml	=> chr(228),  # small a, dieresis or umlaut mark ccedil	=> chr(231),  # small c, cedilla eacute	=> chr(233),  # small e, acute accent ecirc	=> chr(234),  # small e, circumflex accent egrave	=> chr(232),  # small e, grave accent eth	=> chr(240),  # small eth, Icelandic euml	=> chr(235),  # small e, dieresis or umlaut mark iacute	=> chr(237),  # small i, acute accent icirc	=> chr(238),  # small i, circumflex accent igrave	=> chr(236),  # small i, grave accent iuml	=> chr(239),  # small i, dieresis or umlaut mark ntilde	=> chr(241),  # small n, tilde oacute	=> chr(243),  # small o, acute accent ocirc	=> chr(244),  # small o, circumflex accent ograve	=> chr(242),  # small o, grave accent oslash	=> chr(248),  # small o, slash otilde	=> chr(245),  # small o, tilde ouml	=> chr(246),  # small o, dieresis or umlaut mark szlig	=> chr(223),  # small sharp s, German (sz ligature) thorn	=> chr(254),  # small thorn, Icelandic uacute	=> chr(250),  # small u, acute accent ucirc	=> chr(251),  # small u, circumflex accent ugrave	=> chr(249),  # small u, grave accent uuml	=> chr(252),  # small u, dieresis or umlaut mark yacute	=> chr(253),  # small y, acute accent yuml	=> chr(255),  # small y, dieresis or umlaut mark copy   => chr(169),  # copyright sign reg    => chr(174),  # registered sign nbsp   => chr(160),  # non breaking space iexcl  => chr(161), cent   => chr(162), pound  => chr(163), curren => chr(164), yen    => chr(165), brvbar => chr(166), sect   => chr(167), uml    => chr(168), ordf   => chr(170), laquo  => chr(171),
'not'   => chr(172),    # not is a keyword in perl
shy    => chr(173), macr   => chr(175), deg    => chr(176), plusmn => chr(177), sup1   => chr(185), sup2   => chr(178), sup3   => chr(179), acute  => chr(180), micro  => chr(181), para   => chr(182), middot => chr(183), cedil  => chr(184), ordm   => chr(186), raquo  => chr(187), frac14 => chr(188), frac12 => chr(189), frac34 => chr(190), iquest => chr(191),
'times' => chr(215),    # times is a keyword in perl
divide => chr(247), ); for ($string) { s/(&\#(\d+);?)/$2 < 256 ? chr($2) : $1/eg; s/(&\#[xX]([0-9a-fA-F]+);?)/my $c = hex($2); $c < 256 ? chr($c) : $1/eg; s/(&(\w+);?)/$entity2char{$2} || $1/eg; } $string; } 1; 