mirror of
https://gitlab.com/t6353/sharee.bike.git
synced 2024-05-16 22:16:33 +02:00
250 lines
7.4 KiB
Perl
Executable file
250 lines
7.4 KiB
Perl
Executable file
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::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 $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 = "";
|
|
|
|
$bw->log("APIpayone request:\n--> user-agent '$user_agent'",$q,"");
|
|
|
|
if(1==1){
|
|
foreach(@keywords){
|
|
if(length($_) > 40 || length($q->param($_)) > 400){
|
|
print "<text>Failure 19900: amount of characters in $_ exceeds</text>";
|
|
return Apache2::Const::OK;
|
|
exit 0;
|
|
}
|
|
}
|
|
}
|
|
|
|
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()",#just to see who changes at what time
|
|
};
|
|
|
|
|
|
#primary payonelink prepaid transaction-status
|
|
#payone subaccount aid:55218
|
|
if($q->param('aid') eq "55218"){
|
|
print FILE "TeilRad payonelink transaction on $dbt->{primary}->{sharee_primary}->{database}->{dbname}\n";
|
|
|
|
my $update_pos = {
|
|
table => "contenttranspos",
|
|
mtime => "now()",
|
|
owner_end => $owner,
|
|
};
|
|
my $pos_id = "";
|
|
|
|
foreach(@keywords){
|
|
my $val = $q->param($_);
|
|
$val = $q->escapeHTML("$val");
|
|
print FILE "$_=$val\n";
|
|
|
|
#reference keeps ct_id-pos_id
|
|
if($_ eq "reference" && $val =~ /\d+-(\d+)/){
|
|
$pos_id = $1;
|
|
}elsif($_ eq "txid"){
|
|
$update_pos->{txt15} = $val;
|
|
}elsif($_ eq "receivable"){
|
|
$update_pos->{int02} = $val;
|
|
}
|
|
}
|
|
|
|
if($q->param('txaction') eq "paid"){
|
|
$dbh = $dbt->dbconnect_extern($dbt->{primary}->{sharee_primary}->{database}->{dbname});
|
|
my $fetch_ctpos = {
|
|
table => "contenttranspos",
|
|
fetch => "one",
|
|
c_id => $pos_id,
|
|
};
|
|
my $ctpos = { c_id => 0 };
|
|
$ctpos = $dbt->fetch_tablerecord($dbh,$fetch_ctpos) if($pos_id);
|
|
|
|
$dbt->update_record($dbh,$update_pos,$ctpos) if($ctpos->{c_id});
|
|
print FILE Dumper($update_pos) . "\n";
|
|
}
|
|
}
|
|
#operator invoice transaction-status
|
|
else{
|
|
|
|
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 = "";
|
|
my $ctadr_refid = 0;
|
|
|
|
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"){
|
|
#oprefix-C/S-invoicenr reference for preauth/capture
|
|
if($val =~ /^(\w+)-/){
|
|
$update_ctt->{txt25} = $val;
|
|
$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});
|
|
}
|
|
}
|
|
}
|
|
#userid_epoche reference for payment_ack
|
|
elsif($val =~ /^(\d+)_\d+/){
|
|
$ctadr_refid = $1;
|
|
}
|
|
}
|
|
$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");
|
|
}
|
|
|
|
#update on contentadr called payment_ack
|
|
if($ctadr_refid > 0){
|
|
my $fetch_ctadr = {
|
|
table => "contentadr",
|
|
fetch => "one",
|
|
c_id => $ctadr_refid,
|
|
};
|
|
my $ctadr = { c_id => 0 };
|
|
$ctadr = $dbt->fetch_tablerecord($dbh,$fetch_ctadr);
|
|
if($ctadr->{c_id}){
|
|
$update_adr->{int18} = $txid || 0;#in payment_ack contentadr context int18=txid
|
|
$dbt->update_record($dbh,$update_adr,$ctadr);
|
|
$dbt->update_operatorsloop($varenv{dbname},$ctadr->{c_id},"update");
|
|
print FILE "payment_ack ctadr_refid:$ctadr_refid \n" . Dumper($update_adr) . "\n";
|
|
}
|
|
}
|
|
#updates on contentttrans invoice by payone transaction data on matching TXID
|
|
elsif($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_extern($dbt->{primary}->{sharee_primary}->{database}->{dbname});
|
|
$dbt->update_record($dbh_primary,$update_adr,$ctadr);
|
|
print FILE Dumper($update_adr) . "\n";
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
close(FILE);
|
|
|
|
return Apache2::Const::OK;
|
|
}
|
|
1;
|