package Mod::APIpayone; # # SPDX-License-Identifier: AGPL-3.0-or-later # Copyright (c) Rainer Gümpelein, TeilRad GmbH # #Server for payone to get payment state like p-saldo # use lib qw(/var/www/copri-bike/shareeapp-primary/src); use warnings; use strict; use Exporter; our @ISA = qw (Exporter); use POSIX; use CGI; use Apache2::Const -compile => qw(OK ); use Scalar::Util qw(looks_like_number); use LWP::UserAgent; use XML::Simple qw(:strict); use Lib::Config; use Mod::DBtank; use Mod::Basework; use Mod::Shareework; use Mod::APIfunc; use Data::Dumper; use Sys::Hostname; my $hostname = hostname; sub handler { my ($r) = @_; my $q = new CGI; my $netloc = $q->url(-base=>1); #$q->import_names('R'); my $cf = new Config; my $dbt = new DBtank; my $bw = new Basework; my $tk = new Shareework; my $apif = new APIfunc; my %varenv = $cf->envonline(); my $oprefix = $dbt->{operator}->{$varenv{dbname}}->{oprefix}; my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime; my $owner=178;#payone id my @keywords = $q->param; my $user_agent = $q->user_agent(); my $dbh = ""; if(1==1){ foreach(@keywords){ if(length($_) > 40 || length($q->param($_)) > 400){ print "Failure 19900: amount of characters in $_ exceeds"; return Apache2::Const::OK; exit 0; } } } $bw->log("APIpayone request:\n--> user-agent '$user_agent'",$q,""); print $q->header( -charset => 'ISO-8859-1' ); print "TSOK"; open(FILE,">>$varenv{logdir}/APIpayone.log"); print FILE "\n*--> $now_dt on $varenv{syshost}\n"; print FILE "TSOK\n"; #check if transfer my $txaction=""; my $receivable=""; my $txid=""; my $reference=""; my $cardexpiredate=0; my $update_adr = { table => "contentadr", pay_time => "now()", #owner => $owner }; my $update_ctt = { table => "contenttrans", mtime => "now()", pay_time => "now()", #owner => $owner, int14 => 0,#OPOS int16 => 0,#balance int18 => 0,#sequencenumber int19 => 0,#receivable }; my $operator_prefix = ""; foreach(@keywords){ my $val = $q->param($_); $val = $q->escapeHTML("$val"); print FILE "$_=$val\n"; $txaction = $val if($_ eq "txaction"); $receivable = $val if($_ eq "receivable"); $txid = $val if($_ eq "txid"); if($_ eq "reference"){ $update_ctt->{txt25} = $val; if($val =~ /^(\w+)-/){ $operator_prefix = $1; if($operator_prefix ne $oprefix){ my $operator_conf = $dbt->get_operator_conf($operator_prefix); if(ref($operator_conf) eq "HASH" && $operator_conf->{oprefix} && $operator_conf->{database}->{dbname}){ print FILE "operator_prefix ----> $operator_prefix\n"; $dbh = $dbt->dbconnect_extern($operator_conf->{database}->{dbname}); } } } } $update_ctt->{int16} = $val if($_ eq "balance"); $update_ctt->{int18} = $val if($_ eq "sequencenumber"); $update_ctt->{int19} = $val if($_ eq "receivable"); #contentadr $update_adr->{int24} = $val if($_ eq "cardexpiredate"); } #do updates on invoice by payone transaction data on matching TXID if($txid && looks_like_number($update_ctt->{int19}) && looks_like_number($update_ctt->{int16})){ my $ctt = { c_id => 0 }; my $ctadr = { c_id => 0 }; my $fetch_ctt = { table => "contenttrans", fetch => "one", txt16 => $q->escapeHTML($txid), }; $ctt = $dbt->fetch_tablerecord($dbh,$fetch_ctt) if($txid); $ctadr->{c_id} = $ctt->{int10} if($ctt->{int10}); my $fetch_ctadr = { table => "contentadr", fetch => "one", c_id => $ctadr->{c_id}, }; $ctadr = $dbt->fetch_tablerecord($dbh,$fetch_ctadr) if($ctadr->{c_id}); my $vde_on_fail = $ctadr->{int12} || 2;#keep last or set 1 #2023-07-05 changed to set 2 if($ctt->{c_id} > 0){ #balance > 0 then preauthorization or payment fails if($update_ctt->{int16} && $update_ctt->{int16} > 0){ $update_adr->{int12} = $vde_on_fail; $update_ctt->{int14} = 1; $update_ctt->{txt28} = "$now_dt $txaction\nSaldo > 0 Meldung\n" . $ctt->{txt28} if($ctt->{txt28} !~ /0 Meldung,/);#only once; }else{ #2023-02-27, because this will be also done by manually user payment (without valid saved payment data) #$update_adr->{int12} = "null"; $update_ctt->{int14} = "null"; $update_ctt->{txt28} = "$now_dt $txaction\n" . $ctt->{txt28}; } #Testing, if capture price ne receivable, then capture fails #2023-09-05, does not work on payone server-error. there is noch further capture #Look at $pay_state in Address.pm if($txaction eq "capture" && $update_ctt->{int16} == 0 && $ctt->{int01} != $update_ctt->{int19}){ $update_adr->{int12} = $vde_on_fail; $update_ctt->{int14} = 1; $update_ctt->{txt28} = "$now_dt $txaction\nreceivable: $update_ctt->{int19}\n" . $ctt->{txt28}; } $dbt->update_record($dbh,$update_ctt,$ctt); print FILE Dumper($update_ctt) . "\n"; #set cardexpiredate if(($update_adr->{int24} && $update_adr->{int24} > 0 || $ctadr->{int12} ne $update_adr->{int12}) && $ctadr->{c_id} > 0){ $dbt->update_record($dbh,$update_adr,$ctadr); #update adr also on primary my $dbh_primary = $dbt->dbconnect($dbt->{primary}->{sharee_primary}->{database}->{dbname}); $dbt->update_record($dbh_primary,$update_adr,$ctadr); } } } close(FILE); return Apache2::Const::OK; } 1;