mirror of
https://gitlab.com/t6353/sharee.bike.git
synced 2024-11-15 15:06:38 +01:00
701 lines
24 KiB
Perl
701 lines
24 KiB
Perl
|
package Payment;
|
||
|
|
#
|
||
|
|
# SPDX-License-Identifier: AGPL-3.0-or-later
|
||
|
|
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
|
||
|
|
#
|
||
|
|
#Adapted from Prelogic Rechnung "buchen" and "print_pdf"
|
||
|
|
#Adapted from payone_post.pl
|
||
|
|
#
|
||
|
|
#enable for syntax check
|
||
|
|
#use lib "/var/www/copri4/shareedms-primary/src";
|
||
|
|
|
||
|
|
use strict;
|
||
|
|
use warnings;
|
||
|
|
use POSIX;
|
||
|
|
use CGI; # only for debugging
|
||
|
|
use LWP::UserAgent;
|
||
|
|
use URI::Encode;
|
||
|
|
my $uri_encode = URI::Encode->new( { encode_reserved => 1 } );
|
||
|
|
|
||
|
|
use Scalar::Util qw(looks_like_number);
|
||
|
|
use Lib::Config;
|
||
|
|
use Mod::Libenz;
|
||
|
|
use Mod::Libenzdb;
|
||
|
|
use Mod::Callib;
|
||
|
|
use Mod::DBtank;
|
||
|
|
use Mod::Basework;
|
||
|
|
use Data::Dumper;
|
||
|
|
|
||
|
|
my $q = new CGI;
|
||
|
|
my $cf = new Config;
|
||
|
|
my $lb = new Libenz;
|
||
|
|
my $db = new Libenzdb;
|
||
|
|
my $cal = new Callib;
|
||
|
|
my $dbt = new DBtank;
|
||
|
|
my $bw = new Basework;
|
||
|
|
|
||
|
|
|
||
|
|
sub new {
|
||
|
|
my $class = shift;
|
||
|
|
my $self = {};
|
||
|
|
bless($self,$class);
|
||
|
|
return $self;
|
||
|
|
}
|
||
|
|
|
||
|
|
my $ua = LWP::UserAgent->new(
|
||
|
|
ssl_opts => {
|
||
|
|
SSL_version => 'TLSv12:!SSLv2:!SSLv3:!TLSv1:!TLSv11',
|
||
|
|
}
|
||
|
|
);
|
||
|
|
$ua->agent("sharee payone POST API");
|
||
|
|
my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime;
|
||
|
|
|
||
|
|
|
||
|
|
#ported from payone_post.pl
|
||
|
|
#SEPA
|
||
|
|
#Request "managemandate"
|
||
|
|
sub managemandate_main {
|
||
|
|
my $self = shift;
|
||
|
|
my $varenv = shift;
|
||
|
|
my $ctadr = shift;
|
||
|
|
my $ctt = shift || "";
|
||
|
|
my $owner = shift || 0;
|
||
|
|
my $payoneret = "";
|
||
|
|
my $payone_conf = $dbt->{operator}->{$varenv->{dbname}}->{payone_conf} || $dbt->{payone_conf};
|
||
|
|
|
||
|
|
if($ctadr->{c_id}){
|
||
|
|
my $lastname = $ctadr->{txt01};
|
||
|
|
(my $firstname,$lastname) = split(/\s+/,$ctadr->{txt01}) if($ctadr->{txt01} =~ /\w\s+\w/i);
|
||
|
|
chomp($firstname);
|
||
|
|
chomp($lastname);
|
||
|
|
my $city = $ctadr->{txt06};
|
||
|
|
(my $zip, $city) = split(/\s+/,$ctadr->{txt06}) if($ctadr->{txt06} =~ /[\w\d]\s+[\w\d]/i);
|
||
|
|
chomp($zip);
|
||
|
|
chomp($city);
|
||
|
|
|
||
|
|
$ctadr->{txt06} =~ s/[\d\s]+//g;
|
||
|
|
$ctadr->{txt22} =~ s/\s//g;
|
||
|
|
my $bcountry = uc($1) if($ctadr->{txt22} && $ctadr->{txt22} =~ /^(\w{2})/);
|
||
|
|
my $currency = "EUR";
|
||
|
|
$currency = "CHF" if($bcountry eq "CH");
|
||
|
|
$ctadr->{txt23} =~ s/\s//g;
|
||
|
|
my $preauth_request = {
|
||
|
|
request => 'managemandate',
|
||
|
|
clearingtype => 'elv',
|
||
|
|
salution => "$ctadr->{txt02}",
|
||
|
|
firstname => "$firstname",
|
||
|
|
lastname => "$lastname",
|
||
|
|
street => "$ctadr->{txt03}",
|
||
|
|
zip => "$zip",
|
||
|
|
city => "$city",
|
||
|
|
country => "$ctadr->{txt10}",
|
||
|
|
email => "$ctadr->{txt08}",
|
||
|
|
telephonenumber => "$ctadr->{txt07}",
|
||
|
|
currency => "$currency",
|
||
|
|
iban => uc($ctadr->{txt22}),
|
||
|
|
bic => uc($ctadr->{txt23})
|
||
|
|
};
|
||
|
|
|
||
|
|
my $request = { %$payone_conf, %$preauth_request};
|
||
|
|
$payoneret = $self->rpc("managemandate",$varenv,$request,$ctadr,$ctt,$owner) if($request);
|
||
|
|
}
|
||
|
|
return $payoneret;
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
#Request "preauthorizationSEPA"
|
||
|
|
sub preauthorizationSEPA_main {
|
||
|
|
my $self = shift;
|
||
|
|
my $varenv = shift;
|
||
|
|
my $ctadr = shift;
|
||
|
|
my $ctt = shift;
|
||
|
|
my $owner = shift || 0;
|
||
|
|
my $payoneret = "";
|
||
|
|
my $payone_conf = $dbt->{operator}->{$varenv->{dbname}}->{payone_conf} || $dbt->{payone_conf};
|
||
|
|
my $dbh = "";
|
||
|
|
|
||
|
|
#to get actual data
|
||
|
|
my $pref = {
|
||
|
|
table => "contenttrans",
|
||
|
|
fetch => "one",
|
||
|
|
template_id => 205,
|
||
|
|
c_id => $ctt->{c_id},
|
||
|
|
};
|
||
|
|
my $ctt_up = $dbt->fetch_record($dbh,$pref);
|
||
|
|
|
||
|
|
$ctt->{ct_name} = $ctt_up->{ct_name};
|
||
|
|
if($ctt->{renewed}){
|
||
|
|
$ctt->{ct_name} = $ctt_up->{ct_name};
|
||
|
|
if($ctt_up->{ct_name} =~ /\d+-\d+/){
|
||
|
|
my ($ct_name,$subname) = split(/-/,$ctt_up->{ct_name});
|
||
|
|
$subname++;
|
||
|
|
$ctt->{ct_name} = "$ct_name-$subname";
|
||
|
|
}else{
|
||
|
|
$ctt->{ct_name} = "$ctt_up->{ct_name}-1";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if(!$ctt->{reference}){
|
||
|
|
$ctt->{reference} = $dbt->{operator}->{$varenv->{dbname}}->{oprefix} . "-" . $ctt->{ct_name};
|
||
|
|
}
|
||
|
|
|
||
|
|
#2019-05-18, makes only sense if int15 alias $sum_preauth > 0
|
||
|
|
if($ctadr->{c_id} && $ctt->{c_id} && $ctt->{int15} > 0){
|
||
|
|
|
||
|
|
my $lastname = $ctadr->{txt01};
|
||
|
|
(my $firstname,$lastname) = split(/\s+/,$ctadr->{txt01}) if($ctadr->{txt01} =~ /\w\s+\w/i);
|
||
|
|
chomp($firstname);
|
||
|
|
chomp($lastname);
|
||
|
|
my $city = $ctadr->{txt06};
|
||
|
|
(my $zip, $city) = split(/\s+/,$ctadr->{txt06}) if($ctadr->{txt06} =~ /[\w\d]\s+[\w\d]/i);
|
||
|
|
chomp($zip);
|
||
|
|
chomp($city);
|
||
|
|
|
||
|
|
$ctadr->{txt22} =~ s/\s//g;
|
||
|
|
#my $bcountry = uc($1) if($ctadr->{txt22} && $ctadr->{txt22} =~ /^(\w{2})/);
|
||
|
|
my $currency = "EUR";
|
||
|
|
#$currency = "CHF" if($bcountry eq "CH");
|
||
|
|
$ctadr->{txt23} =~ s/\s//g;
|
||
|
|
my $amount = 0;
|
||
|
|
$amount = $ctt->{int15} * 100 if($ctt->{int15});
|
||
|
|
my $preauth_request = {
|
||
|
|
request => 'preauthorization',
|
||
|
|
clearingtype => 'elv',
|
||
|
|
salution => "$ctadr->{txt02}",
|
||
|
|
firstname => "$firstname",
|
||
|
|
lastname => "$lastname",
|
||
|
|
street => "$ctadr->{txt03}",
|
||
|
|
zip => "$zip",
|
||
|
|
city => "$city",
|
||
|
|
country => "$ctadr->{txt10}",
|
||
|
|
email => "$ctadr->{txt08}",
|
||
|
|
telephonenumber => "$ctadr->{txt07}",
|
||
|
|
#sequencenumber => "0",
|
||
|
|
amount => "$amount",
|
||
|
|
currency => "$currency",
|
||
|
|
iban => uc($ctadr->{txt22}),
|
||
|
|
bic => uc($ctadr->{txt23}),
|
||
|
|
reference => "$ctt->{reference}"
|
||
|
|
};
|
||
|
|
$preauth_request->{ip} = "$ctadr->{txt25}" if($ctadr->{txt25} && $ctadr->{txt25} =~ /\d+\.\d+\.\d+\.\d+/);
|
||
|
|
my $request = { %$payone_conf, %$preauth_request};
|
||
|
|
$payoneret = $self->rpc("preauthorizationSEPA",$varenv,$request,$ctadr,$ctt,$owner) if($request);
|
||
|
|
}
|
||
|
|
return $payoneret;
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
#Request "captureSEPA"
|
||
|
|
sub captureSEPA_main {
|
||
|
|
my $self = shift;
|
||
|
|
my $varenv = shift;
|
||
|
|
my $ctadr = shift;
|
||
|
|
my $ctt = shift;
|
||
|
|
my $owner = shift || 0;
|
||
|
|
my $payoneret = "";
|
||
|
|
my $payone_conf = $dbt->{operator}->{$varenv->{dbname}}->{payone_conf} || $dbt->{payone_conf};
|
||
|
|
|
||
|
|
if($ctt->{c_id} && (!$ctt->{state} || $ctt->{int14})){
|
||
|
|
my $amount = 0;
|
||
|
|
$amount = $ctt->{int01} * 100 if($ctt->{int01});
|
||
|
|
my $currency = "EUR";
|
||
|
|
|
||
|
|
my $preauth_request = {
|
||
|
|
request => 'capture',
|
||
|
|
amount => "$amount",
|
||
|
|
currency => "$currency",
|
||
|
|
txid => "$ctt->{txt16}"
|
||
|
|
};
|
||
|
|
my $request = { %$payone_conf, %$preauth_request};
|
||
|
|
$payoneret = $self->rpc("captureSEPA",$varenv,$request,$ctadr,$ctt,$owner) if($request);
|
||
|
|
}
|
||
|
|
return $payoneret;
|
||
|
|
}
|
||
|
|
|
||
|
|
#CC
|
||
|
|
#Request "preauthorizationCC"
|
||
|
|
sub preauthorizationCC_main {
|
||
|
|
my $self = shift;
|
||
|
|
my $varenv = shift;
|
||
|
|
my $ctadr = shift;
|
||
|
|
my $ctt = shift;
|
||
|
|
my $owner = shift || 0;
|
||
|
|
my $payoneret = "";
|
||
|
|
my $payone_conf = $dbt->{operator}->{$varenv->{dbname}}->{payone_conf} || $dbt->{payone_conf};
|
||
|
|
my $dbh = "";
|
||
|
|
|
||
|
|
#to get actual data
|
||
|
|
my $pref = {
|
||
|
|
table => "contenttrans",
|
||
|
|
fetch => "one",
|
||
|
|
template_id => 218,
|
||
|
|
c_id => $ctt->{c_id},
|
||
|
|
};
|
||
|
|
my $ctt_up = $dbt->fetch_record($dbh,$pref);
|
||
|
|
|
||
|
|
$ctt->{ct_name} = $ctt_up->{ct_name};
|
||
|
|
if($ctt->{renewed}){
|
||
|
|
$ctt->{ct_name} = $ctt_up->{ct_name};
|
||
|
|
if($ctt_up->{ct_name} =~ /\d+-\d+/){
|
||
|
|
my ($ct_name,$subname) = split(/-/,$ctt_up->{ct_name});
|
||
|
|
$subname++;
|
||
|
|
$ctt->{ct_name} = "$ct_name-$subname";
|
||
|
|
}else{
|
||
|
|
$ctt->{ct_name} = "$ctt_up->{ct_name}-1";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if(!$ctt->{reference}){
|
||
|
|
$ctt->{reference} = $dbt->{operator}->{$varenv->{dbname}}->{oprefix} . "-" . $ctt->{ct_name};
|
||
|
|
}
|
||
|
|
|
||
|
|
#2019-05-18, makes only sense if int15 alias $sum_preauth > 0
|
||
|
|
if($ctadr->{c_id} && $ctt->{c_id} && $ctt->{int15} > 0){
|
||
|
|
my $lastname = $ctadr->{txt01};
|
||
|
|
(my $firstname,$lastname) = split(/\s+/,$ctadr->{txt01}) if($ctadr->{txt01} =~ /\w\s+\w/);
|
||
|
|
chomp($firstname);
|
||
|
|
chomp($lastname);
|
||
|
|
my $city = $ctadr->{txt06};
|
||
|
|
(my $zip, $city) = split(/\s+/,$ctadr->{txt06}) if($ctadr->{txt06} =~ /[\w\d]\s+[\w\d]/);
|
||
|
|
chomp($zip);
|
||
|
|
chomp($city);
|
||
|
|
|
||
|
|
my $amount = 0;
|
||
|
|
$amount = $ctt->{int15} * 100 if($ctt->{int15});
|
||
|
|
my $preauth_request = {
|
||
|
|
request => 'preauthorization',
|
||
|
|
clearingtype => 'cc',
|
||
|
|
salution => "$ctadr->{txt02}",
|
||
|
|
firstname => "$firstname",
|
||
|
|
lastname => "$lastname",
|
||
|
|
street => "$ctadr->{txt03}",
|
||
|
|
zip => "$zip",
|
||
|
|
city => "$city",
|
||
|
|
country => "$ctadr->{txt10}",
|
||
|
|
email => "$ctadr->{txt08}",
|
||
|
|
telephonenumber => "$ctadr->{txt07}",
|
||
|
|
#sequencenumber => '0',
|
||
|
|
amount => "$amount",
|
||
|
|
currency => 'EUR',
|
||
|
|
#Parameter ( personal data )
|
||
|
|
lastname => "$ctadr->{txt01}",
|
||
|
|
country => "$ctadr->{txt10}",
|
||
|
|
pseudocardpan => "$ctadr->{ct_name}",
|
||
|
|
ecommercemode => "internet", # wird zu 3Dscheck,
|
||
|
|
reference => "$ctt->{reference}"
|
||
|
|
};
|
||
|
|
# https://docs.payone.com/display/public/PLATFORM/Special+remarks+-+Recurring+transactions+credit+card
|
||
|
|
# https://docs.payone.com/display/public/INT/Best+Practices+for+PSD2#tab-3DS+2.0+Best+Case
|
||
|
|
$preauth_request->{ip} = "$ctadr->{txt25}" if($ctadr->{txt25} && $ctadr->{txt25} =~ /\d+\.\d+\.\d+\.\d+/);
|
||
|
|
my $request = { %$payone_conf, %$preauth_request};
|
||
|
|
$payoneret = $self->rpc("preauthorizationCC",$varenv,$request,$ctadr,$ctt,$owner) if($request);
|
||
|
|
}
|
||
|
|
return $payoneret;
|
||
|
|
}
|
||
|
|
|
||
|
|
#Request "captureCC"
|
||
|
|
sub captureCC_main {
|
||
|
|
my $self = shift;
|
||
|
|
my $varenv = shift;
|
||
|
|
my $ctadr = shift;
|
||
|
|
my $ctt = shift;
|
||
|
|
my $owner = shift || 0;
|
||
|
|
my $payoneret = "";
|
||
|
|
my $payone_conf = $dbt->{operator}->{$varenv->{dbname}}->{payone_conf} || $dbt->{payone_conf};
|
||
|
|
|
||
|
|
if($ctt->{c_id} && (!$ctt->{state} || $ctt->{int14} || $ctt->{txt28})){
|
||
|
|
my $amount = 0;
|
||
|
|
$amount = $ctt->{int01} * 100 if($ctt->{int01});
|
||
|
|
my $preauth_request = {
|
||
|
|
request => 'capture',
|
||
|
|
amount => "$amount",
|
||
|
|
currency => 'EUR',
|
||
|
|
txid => "$ctt->{txt16}"
|
||
|
|
};
|
||
|
|
my $request = { %$payone_conf, %$preauth_request};
|
||
|
|
$payoneret = $self->rpc("captureCC",$varenv,$request,$ctadr,$ctt,$owner) if($request);
|
||
|
|
}
|
||
|
|
return $payoneret;
|
||
|
|
}
|
||
|
|
|
||
|
|
#TODO
|
||
|
|
#with previous preauthorization/ authorization and clearingtype=”elv”:
|
||
|
|
#An “amount = 0” can be used to cancel a
|
||
|
|
#direct debit transaction. This is not possible if the parameter “due_time” has
|
||
|
|
#been used, if the portal has enabled a delayed settlement (setup by PAYONE) or
|
||
|
|
#the direct debit has already been processed (after midnight).
|
||
|
|
#./src/scripts/payone_post.pl $varenv{syshost} refund contenttrans "" 6799 4
|
||
|
|
##Request "refund" (Rückerstattung)
|
||
|
|
#txt16=txid must be copied from last captured invoice.
|
||
|
|
#int01 sum must be set!
|
||
|
|
#sequenz = 2
|
||
|
|
#sudo su www-data -c "./src/scripts/payone_post.pl tinkdms refund contenttrans '' 32332 2"
|
||
|
|
sub refund {
|
||
|
|
my $self = shift;
|
||
|
|
my $varenv = shift;
|
||
|
|
my $ctadr = shift;
|
||
|
|
my $ctt = shift;
|
||
|
|
my $owner = shift || 0;
|
||
|
|
my $sequenz = shift || 0;
|
||
|
|
my $payoneret = "";
|
||
|
|
my $payone_conf = $dbt->{operator}->{$varenv->{dbname}}->{payone_conf} || $dbt->{payone_conf};
|
||
|
|
|
||
|
|
if($ctt->{c_id}){
|
||
|
|
my $amount = 0;
|
||
|
|
$amount = $ctt->{int01} * 100 if($ctt->{int01});
|
||
|
|
my $currency = "EUR";
|
||
|
|
|
||
|
|
my $preauth_request = {
|
||
|
|
request => 'refund',
|
||
|
|
sequencenumber => "$sequenz",#$sequenz= must be +1 of the last capture
|
||
|
|
amount => "$amount",
|
||
|
|
currency => "$currency",
|
||
|
|
txid => "$ctt->{txt16}"
|
||
|
|
};
|
||
|
|
my $request = { %$payone_conf, %$preauth_request};
|
||
|
|
$payoneret = $self->rpc("refund",$varenv,$request,$ctadr,$ctt,$owner) if($request);
|
||
|
|
}
|
||
|
|
return $payoneret;
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
####################################################################################
|
||
|
|
#Create a request
|
||
|
|
sub rpc {
|
||
|
|
my $self = shift;
|
||
|
|
my $todo = shift;
|
||
|
|
my $varenv = shift;
|
||
|
|
my $request = shift;
|
||
|
|
my $ctadr = shift || { c_id => 0 };
|
||
|
|
my $ctt = shift || { c_id => 0 };
|
||
|
|
my $owner = shift || 0;
|
||
|
|
my $payoneret = "";
|
||
|
|
my $dbh = "";
|
||
|
|
|
||
|
|
#payone API URL
|
||
|
|
my $payoneLive = 1;
|
||
|
|
my $httpReqServer = "https://api.pay1.de/post-gateway/";
|
||
|
|
my $req = HTTP::Request->new(POST => "$httpReqServer");
|
||
|
|
|
||
|
|
my $post;
|
||
|
|
foreach (keys (%$request)){
|
||
|
|
my $encoded_val = $uri_encode->encode($request->{$_});
|
||
|
|
$post .= "$_=$encoded_val&";
|
||
|
|
}
|
||
|
|
$post =~ s/\&$//;
|
||
|
|
$req->content_type('application/x-www-form-urlencoded');
|
||
|
|
$req->content($post);
|
||
|
|
|
||
|
|
#Pass request to the user agent and get a response back
|
||
|
|
my $res = $ua->request($req);
|
||
|
|
my $vde_on_fail = $ctadr->{int12} || 1;#keep last or set 1
|
||
|
|
my $debug=0;
|
||
|
|
$debug=1;
|
||
|
|
|
||
|
|
my $update_adr = {
|
||
|
|
table => "contentadr",
|
||
|
|
mtime => "now()",
|
||
|
|
owner => $owner
|
||
|
|
};
|
||
|
|
|
||
|
|
my $update_ctt = {
|
||
|
|
table => "contenttrans",
|
||
|
|
mtime => "now()",
|
||
|
|
owner => $owner
|
||
|
|
};
|
||
|
|
|
||
|
|
|
||
|
|
open(FILE,">>$varenv->{logdir}/payone-return-post.log") if($debug);
|
||
|
|
print FILE "\n*** $now_dt (ctadr_id:$ctadr->{c_id}, ctt_id:$ctt->{c_id}) from payone_post.pl\n$httpReqServer \n" if($debug);
|
||
|
|
print FILE "---> request to payone $todo:\n$post\n";
|
||
|
|
|
||
|
|
#Payone CONFIGURATION TransactionStatus URL:
|
||
|
|
#https://tinkrpc.copri.eu/src/scripts/postread_server.pl
|
||
|
|
#Check the outcome of the response
|
||
|
|
if ($res->is_success) {
|
||
|
|
print FILE "<--- return from payone $todo:\n" . $res->content . "\n" if($debug);
|
||
|
|
#print FILE Dumper($res);
|
||
|
|
my @content = split(/\n/,$res->content);
|
||
|
|
|
||
|
|
print FILE $res->status_line, "\n" if($debug);
|
||
|
|
if($res->content =~ /status=APPROVED|status=REDIRECT/){
|
||
|
|
#SEPA
|
||
|
|
if($todo =~ /managemandate/){
|
||
|
|
my $mival = "";
|
||
|
|
$mival = $1 if($res->content =~ /mandate_identification=(.*)/);
|
||
|
|
$payoneret = $mival;
|
||
|
|
print FILE "mival: $mival && $ctadr->{c_id}\n" if($debug);
|
||
|
|
|
||
|
|
if($mival && $ctadr->{c_id}){
|
||
|
|
foreach(@content){
|
||
|
|
my ($key,$val) = split(/=/,$_);
|
||
|
|
$val = $q->escapeHTML("$val");
|
||
|
|
$update_adr->{txt22} = $val if($key eq "iban");
|
||
|
|
$update_adr->{txt23} = $val if($key eq "bic");
|
||
|
|
$update_adr->{ct_name} = $val if($key eq "mandate_identification");
|
||
|
|
$update_adr->{txt27} = $val if($key eq "mandate_status");
|
||
|
|
$update_adr->{txt28} = $val if($key eq "mandate_text" && ($val =~ /SEPA/ || !$val));
|
||
|
|
}
|
||
|
|
$update_adr->{int12} = 0;#Vde
|
||
|
|
$dbt->update_record($dbh,$update_adr,$ctadr) if($ctadr->{c_id} > 0);
|
||
|
|
my $ret = $self->pdfmandat($varenv,$ctadr->{c_id});
|
||
|
|
print FILE "pdfmandat call generates: $ret\n" if($debug);
|
||
|
|
}elsif($ctadr->{c_id}){
|
||
|
|
$update_adr->{int12} = $vde_on_fail;#Vde
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
my $txidval = "";
|
||
|
|
|
||
|
|
#CC and SEPA after preauthorization
|
||
|
|
if($todo =~ /preauthorization/){
|
||
|
|
$txidval = $1 if($res->content =~ /txid=(\d+)/);
|
||
|
|
$payoneret = $txidval;
|
||
|
|
print FILE "$todo: $txidval && $ctt->{c_id} && $ctadr->{c_id}\n" if($debug);
|
||
|
|
my $useridval = $1 if($res->content =~ /userid=(\d+)/);#2020-02-11 preauthorization returns payone Debitorennr
|
||
|
|
$update_ctt->{ct_name} = $ctt->{ct_name} if($ctt->{ct_name});
|
||
|
|
|
||
|
|
if($txidval && $ctt->{c_id} && $ctadr->{c_id}){
|
||
|
|
$update_ctt->{int03} = $ctadr->{int03};
|
||
|
|
$update_ctt->{int17} = $useridval if($useridval);
|
||
|
|
$update_ctt->{txt16} = $txidval;
|
||
|
|
$update_ctt->{txt22} = $ctt->{renewed} if($ctt->{renewed});
|
||
|
|
$update_ctt->{txt26} = $ctadr->{ct_name};#Mandat/pseudocp
|
||
|
|
$update_ctt->{txt28} = "";
|
||
|
|
$update_adr->{int12} = 0;
|
||
|
|
$update_adr->{int17} = $useridval if($useridval);
|
||
|
|
$update_adr->{txt28} = "";
|
||
|
|
}elsif($ctadr->{c_id}){
|
||
|
|
$update_ctt->{int14} = 1;#OPOS
|
||
|
|
$update_ctt->{txt28} = $now_dt . $res->content;
|
||
|
|
$update_adr->{int12} = $vde_on_fail;#Vde
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
#Capture
|
||
|
|
if($todo =~ /capture/){
|
||
|
|
$txidval = $1 if($res->content =~ /txid=(\d+)/);
|
||
|
|
$payoneret = $txidval;
|
||
|
|
print FILE "$todo: ($txidval && $ctt->{c_id} && $ctadr->{c_id})\n" if($debug);
|
||
|
|
|
||
|
|
if($txidval && $ctt->{c_id} && $ctadr->{c_id} && $res->content =~ /settleaccount=/){
|
||
|
|
#int01 and state will be set by "buchen" via Prelogic
|
||
|
|
$update_ctt->{int14} = "null";
|
||
|
|
$update_ctt->{txt28} = "";
|
||
|
|
$update_adr->{int12} = 0;
|
||
|
|
$update_adr->{txt28} = "";
|
||
|
|
}else{#because of Prelogic logic set it empty if no capture
|
||
|
|
$update_ctt->{int14} = 1;#OPOS
|
||
|
|
$update_ctt->{txt28} = $now_dt . $res->content;
|
||
|
|
$update_adr->{int12} = $vde_on_fail;#Vde
|
||
|
|
#system(`$varenv->{basedir}/src/Mod/newsletter_tink.pl "$varenv->{basedir}" "$varenv->{wwwhost}" "send_capture_fail" "$ctadr->{c_id}" "$ctt->{ct_name}"`);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
}else{#not APPROVED
|
||
|
|
print FILE "not APPROVED: ($ctt->{c_id} && $res->content)\n" if($debug);
|
||
|
|
$update_ctt->{int14} = 1 if($ctt->{state} && $ctt->{state} !~ /Zahlungseingang/);;#OPOS
|
||
|
|
|
||
|
|
#errormessage=Reference number already exists --> disabled
|
||
|
|
#errormessage=Amount no longer available --> disabled
|
||
|
|
if($res->content !~ /errorcode=911/){
|
||
|
|
|
||
|
|
my $payone_message = "$now_dt\n" . $res->content . "\nAufgrund der payone Ablehnung wurde der Verleih gesperrt. Die Bankdaten müssen überarbeitet werden\n";
|
||
|
|
if($payoneLive == 1 && $ctadr->{c_id}){
|
||
|
|
$update_ctt->{txt28} = $payone_message;
|
||
|
|
$update_adr->{txt28} = $payone_message;
|
||
|
|
#never delete on state=occupied, in this case ist must delete it on available
|
||
|
|
if($res->content !~ /errorcode=80/){
|
||
|
|
$update_adr->{int12} = $vde_on_fail;#Vde
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if($payoneLive == 1 && $ctt->{c_id}){
|
||
|
|
$update_adr->{txt28} = $payone_message;
|
||
|
|
}
|
||
|
|
|
||
|
|
}else{
|
||
|
|
if($payoneLive == 1 && $ctt->{c_id}){
|
||
|
|
my $payone_message = "$now_dt\n" . $res->content . "\n";
|
||
|
|
$update_ctt->{txt28} = $payone_message;
|
||
|
|
$update_adr->{txt28} = $payone_message;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}else {
|
||
|
|
print FILE $res->status_line, "\n" if($debug);
|
||
|
|
}
|
||
|
|
|
||
|
|
close(FILE) if($debug);
|
||
|
|
$dbt->update_record($dbh,$update_adr,$ctadr) if($ctadr->{c_id} > 0);
|
||
|
|
$dbt->update_record($dbh,$update_ctt,$ctt) if($ctt->{c_id} > 0);
|
||
|
|
return $payoneret;
|
||
|
|
}
|
||
|
|
|
||
|
|
#SEPA PDFGenerator
|
||
|
|
sub pdfmandat {
|
||
|
|
my $self = shift;
|
||
|
|
my $varenv = shift;
|
||
|
|
my $c_id = shift || 0;
|
||
|
|
|
||
|
|
my $dbh = "";
|
||
|
|
my $authref = {
|
||
|
|
table => "contentadr",
|
||
|
|
fetch => "one",
|
||
|
|
template_id => "202",
|
||
|
|
c_id => "$c_id",
|
||
|
|
};
|
||
|
|
my $ctadr = $dbt->fetch_record($dbh,$authref);
|
||
|
|
|
||
|
|
open(EMA, ">> $varenv->{logdir}/SEPA-PDFprint.log");
|
||
|
|
print EMA "*** $now_dt trying pdf --> $varenv->{basedir}/pdfinvoice/SEPA-Lastschriftmandat-$varenv->{dbname}-$ctadr->{ct_name}.pdf && $ctadr->{txt27}\n";
|
||
|
|
if((! -f "$varenv->{basedir}/pdfinvoice/SEPA-Lastschriftmandat-$varenv->{dbname}-$ctadr->{ct_name}.pdf") && $ctadr->{txt27} && $ctadr->{txt27} =~ /active|pending/){
|
||
|
|
my $topdf = "$varenv->{basedir}/src/wkhtmltopdf-amd64";
|
||
|
|
my $print_return = `$topdf --page-size A4 "$varenv->{wwwhost}/PDFGenerator?printer_id=SEPA-Lastschriftmandat\&mandant_main_id=$dbt->{shareedms_conf}->{parent_id}\&id=$ctadr->{c_id}" $varenv->{basedir}/pdfinvoice/SEPA-Lastschriftmandat-$varenv->{dbname}-$ctadr->{ct_name}.pdf 2>&1`;
|
||
|
|
my $exit_code = $?;
|
||
|
|
my $filesize = -s "$varenv->{basedir}/pdfinvoice/SEPA-Lastschriftmandat-$varenv->{dbname}-$ctadr->{ct_name}.pdf";
|
||
|
|
print EMA "$topdf --page-size A4 '$varenv->{wwwhost}/PDFGenerator?printer_id=SEPA-Lastschriftmandat\&mandant_main_id=$dbt->{shareedms_conf}->{parent_id}\&id=$ctadr->{c_id}' $varenv->{basedir}/pdfinvoice/SEPA-Lastschriftmandat-$varenv->{dbname}-$ctadr->{ct_name}.pdf\nreturn: $print_return\nfilesize: $filesize\nexit_code: $exit_code\n";
|
||
|
|
}
|
||
|
|
close EMA;
|
||
|
|
return "$varenv->{logdir}/pdfinvoice/SEPA-Lastschriftmandat-$varenv->{dbname}-$ctadr->{ct_name}.pdf";
|
||
|
|
}
|
||
|
|
#end ported from payone_post.pl
|
||
|
|
#
|
||
|
|
|
||
|
|
#jused by payone_cron.pl
|
||
|
|
sub payone_capture(){
|
||
|
|
my $self = shift;
|
||
|
|
my $varenv = shift;
|
||
|
|
my $ctf = shift;
|
||
|
|
my $ctadr = shift;
|
||
|
|
my $ctt = shift;
|
||
|
|
my $sum_paid = shift;
|
||
|
|
my $owner = shift;
|
||
|
|
|
||
|
|
my $lang = "de";
|
||
|
|
my $mandant_id = 100002;
|
||
|
|
my $main_id = 300008;#Rechnung
|
||
|
|
my $today4db = strftime("%Y-%m-%d %H:%M:%S",localtime(time));
|
||
|
|
my $retval = {};
|
||
|
|
my $return_text = "\n";
|
||
|
|
my $dbh = "";
|
||
|
|
|
||
|
|
#Node and HoleCkeck depended auto Rechnungs-Nummer
|
||
|
|
my $node = $db->get_node4multi($main_id,$lang);#Rechnung node
|
||
|
|
if($node->{int06} > 0){
|
||
|
|
if($ctt->{ct_name} !~ /\d/){
|
||
|
|
#HoleCheck if ReNr available before ReNr counter
|
||
|
|
my $ReNr_start = 40000;
|
||
|
|
my $freeNr = $lb->get_freeReNr("contenttrans","$ReNr_start","$node->{int06}","txt00","$node->{node_name}");
|
||
|
|
my $nextNr = $node->{int06};
|
||
|
|
$nextNr = $freeNr if($freeNr && $freeNr < $node->{int06});
|
||
|
|
$db->update_content4change("contenttrans",$ctt->{c_id},$nextNr,$nextNr,"barcode");
|
||
|
|
if(!$freeNr){
|
||
|
|
my $int06 = $node->{int06} + 1;
|
||
|
|
$db->updater("nodes","main_id",$main_id,"int06",$int06,"","","","","no_time");
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}else{
|
||
|
|
$return_text = "---> payone_cron Payment.pm exit, $node->{int06} | $ctt->{ct_name} can not generate invoice number\n";
|
||
|
|
return $return_text;
|
||
|
|
}
|
||
|
|
|
||
|
|
#We do it only if txt80 end_time in Firma is defined
|
||
|
|
my $max_timestamp;
|
||
|
|
if($ctf->{txt80} && $ctt->{txt20}){
|
||
|
|
if($ctt->{txt20} =~ /(\d{2})\.(\d{2})\.(\d{4})$/){
|
||
|
|
$max_timestamp = "$1.$2.$3 23:59";
|
||
|
|
}else{
|
||
|
|
$return_text = "---> Payment.pm max_timestamp: $max_timestamp fails and exit\n";
|
||
|
|
return $return_text;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
my $state = $ctt->{state};
|
||
|
|
if($varenv->{Zahlungsweise}){
|
||
|
|
my @_paymentstate = split(/\|/,$varenv->{Zahlungsweise});
|
||
|
|
if($ctadr->{int03} && $ctadr->{int03} == 1 && $ctadr->{ct_name} =~ /\w{2}-\d+/){
|
||
|
|
$state = "$_paymentstate[0]";
|
||
|
|
}else{
|
||
|
|
undef $_paymentstate[0];
|
||
|
|
}
|
||
|
|
if($ctadr->{int03} && $ctadr->{int03} == 2 && length($ctadr->{ct_name}) >= 19){
|
||
|
|
$state = "$_paymentstate[1]";
|
||
|
|
}else{
|
||
|
|
undef $_paymentstate[1];
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
$db->update_content4change("contenttrans",$ctt->{c_id},"","$sum_paid","int01");
|
||
|
|
$db->update_content4change("contenttrans",$ctt->{c_id},"",$state,"state");
|
||
|
|
$db->update_content4change("contenttrans",$ctt->{c_id},"",$owner,"owner");
|
||
|
|
$db->updater("contenttrans","c_id",$ctt->{c_id},"int14","2","","","","","");#must be to capture
|
||
|
|
#in cron we set OPOS anyway. If payone captured, it will be set int14=null
|
||
|
|
if(!$state || $state !~ /payone/){
|
||
|
|
$db->updater("contenttrans","c_id",$ctt->{c_id},"txt22","cronjob fail","","","","","");
|
||
|
|
$return_text = "---> Payment.pm can not preauthorization because of absent payment-data in ctadr.c_id:$ctadr->{c_id}, SEPA/CC:$ctadr->{int03}, $ctadr->{ct_name}, we exit\n";
|
||
|
|
return $return_text;
|
||
|
|
}
|
||
|
|
|
||
|
|
#preauth
|
||
|
|
if($ctadr->{int03} && $ctadr->{int03} == 1 && $ctadr->{ct_name} && $ctadr->{ct_name} =~ /\w{2}-\d+/ && (!$ctt->{txt16} || $ctt->{int03} ne "1")){
|
||
|
|
$return_text .= "---> trying payone preauthorizationSEPA\n";
|
||
|
|
$self->preauthorizationSEPA_main($varenv,$ctadr,$ctt,$owner);
|
||
|
|
|
||
|
|
sleep 2;
|
||
|
|
}elsif($ctadr->{int03} && $ctadr->{int03} == 2 && $ctadr->{ct_name} && length($ctadr->{ct_name}) >= 19 && (!$ctt->{txt16} || $ctt->{int03} ne "2")){
|
||
|
|
$return_text .= "---> trying payone preauthorizationCC\n";
|
||
|
|
$self->preauthorizationCC_main($varenv,$ctadr,$ctt,$owner);
|
||
|
|
sleep 2;
|
||
|
|
}
|
||
|
|
|
||
|
|
#check if preauth txid is done by payone
|
||
|
|
$ctt = $db->get_content1("contenttrans",$ctt->{c_id});
|
||
|
|
|
||
|
|
#SEPA capture
|
||
|
|
if($ctt->{int03} == 1 && $ctt->{txt16} && $ctt->{state} =~ /SEPA/){#SEPA
|
||
|
|
$return_text .= "---> trying payone captureSEPA\n";
|
||
|
|
$self->captureSEPA_main($varenv,$ctadr,$ctt,$owner);
|
||
|
|
}
|
||
|
|
#CC capture
|
||
|
|
if($ctt->{int03} == 2 && $ctt->{txt16} && $ctt->{state} =~ /Kreditkarte/){#CC
|
||
|
|
$return_text .= "---> trying payone captureCC\n";
|
||
|
|
$self->captureCC_main($varenv,$ctadr,$ctt,$owner);
|
||
|
|
}
|
||
|
|
|
||
|
|
#Rechnungspositionen itime > end Abrechnunsgdatum --> results in generating new Invoice
|
||
|
|
if($max_timestamp && $varenv->{wwwhost} =~ /tink/){
|
||
|
|
my $ctpos_ck = $db->get_content7("contenttranspos","ct_id",$ctt->{c_id},"itime",">","$max_timestamp");
|
||
|
|
if($ctpos_ck->{c_id}){
|
||
|
|
my $ctadr = $db->get_content7("contentadr","c_id",$ctadr->{c_id});
|
||
|
|
my $ct_id = $dbt->insert_contenttrans($dbh,$ctadr,"300008","218","----",$owner);
|
||
|
|
$db->updater("contenttrans","c_id",$ct_id,"start_time","$ctt->{start_time}",$owner);
|
||
|
|
$db->updater("contenttrans","c_id",$ct_id,"end_time","$ctt->{end_time}",$owner);
|
||
|
|
|
||
|
|
$db->updater("contenttranspos","ct_id",$ctt->{c_id},"ct_id",$ct_id,"","itime",">","$max_timestamp","no_time");
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
#wkhtml
|
||
|
|
#TODO to sharee
|
||
|
|
if(1==1){
|
||
|
|
my $praefix = "$ctt->{txt00}-TINK";
|
||
|
|
my $wc_line= $ctt->{int04};#Adresse.Tabelle
|
||
|
|
my $topdf = "$varenv->{basedir}/src/wkhtmltopdf-amd64";
|
||
|
|
my $print_return = `$topdf --page-size A4 "$varenv->{wwwhost}/Printpreview?printer_id=PDF\&mandant_main_id=$mandant_id\&main_id=$main_id\&ct_name2print=$ctt->{ct_name}\&c_id4trans=$ctt->{c_id}\&u_id=$owner\&wc=$wc_line" $varenv->{pdf}/$praefix-$ctt->{ct_name}.pdf 2>&1`;
|
||
|
|
$return_text .= "$topdf --page-size A4 \"$varenv->{wwwhost}/Printpreview?printer_id=PDF\&mandant_main_id=$mandant_id\&main_id=$main_id\&ct_name2print=$ctt->{ct_name}\&c_id4trans=$ctt->{c_id}\&u_id=$owner\&wc=$wc_line\" $varenv->{pdf}/$praefix-$ctt->{ct_name}.pdf\n";
|
||
|
|
|
||
|
|
#send_invoice infomail
|
||
|
|
if(-f "$varenv->{pdf}/$praefix-$ctt->{ct_name}.pdf"){
|
||
|
|
system(`$varenv->{basedir}/src/Mod/newsletter_tink.pl "$varenv->{basedir}" "$varenv->{wwwhost}" "send_invoice" "$ctadr->{c_id}" "$ctt->{ct_name}"`);
|
||
|
|
$return_text .= "---> Sent Invoice Info e-mail\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
}
|
||
|
|
#TODO
|
||
|
|
#$retval = $db->get_content1("contenttrans",$ctt->{c_id});
|
||
|
|
return ($retval,$return_text);
|
||
|
|
}
|
||
|
|
|
||
|
|
1;
|
||
|
|
|
||
|
|
|