2021-12-30 12:05:56 +01:00
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
2022-02-22 08:31:35 +01:00
#use lib "/var/www/copri-bike/shareedms-primary/src";
2021-12-30 12:05:56 +01:00
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::Callib ;
use Mod::DBtank ;
use Mod::Basework ;
use Data::Dumper ;
my $ q = new CGI ;
my $ cf = new Config ;
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" ) ;
#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" ;
2022-02-22 08:31:35 +01:00
#$currency = "CHF" if($bcountry eq "CH");
2021-12-30 12:05:56 +01:00
$ 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 ;
2022-02-17 13:41:16 +01:00
my $ ctt_rec = shift ;
2021-12-30 12:05:56 +01:00
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" ,
2022-02-04 15:42:58 +01:00
template_id = > 218 ,
2022-02-17 13:41:16 +01:00
c_id = > $ ctt_rec - > { c_id } ,
2021-12-30 12:05:56 +01:00
} ;
2022-02-17 13:41:16 +01:00
my $ ctt = { c_id = > 0 } ;
$ ctt = $ dbt - > fetch_record ( $ dbh , $ pref ) ;
2021-12-30 12:05:56 +01:00
2022-02-22 08:31:35 +01:00
if ( $ ctt_rec - > { payone_reset } ) {
2022-02-17 13:41:16 +01:00
if ( $ ctt - > { ct_name } =~ /\d+-\d+/ ) {
my ( $ ct_name , $ subname ) = split ( /-/ , $ ctt - > { ct_name } ) ;
2021-12-30 12:05:56 +01:00
$ subname + + ;
$ ctt - > { ct_name } = "$ct_name-$subname" ;
} else {
2022-02-17 13:41:16 +01:00
$ ctt - > { ct_name } = "$ctt->{ct_name}-1" ;
2021-12-30 12:05:56 +01:00
}
}
2022-02-18 20:23:45 +01:00
my $ preauth_amount = 0 ;
2022-02-20 09:10:00 +01:00
my $ reference = "" ;
2022-02-18 20:23:45 +01:00
#for testing payment-data
if ( $ ctt_rec - > { c_id } && $ ctt_rec - > { c_id } == 1 && $ ctt_rec - > { reference } ) {
$ ctt = $ ctt_rec ;
$ preauth_amount = $ ctt - > { int15 } ; #int15 should only used for testing payment-data
2022-02-20 09:10:00 +01:00
$ reference = $ ctt_rec - > { reference } ;
2022-02-18 20:23:45 +01:00
} else {
$ preauth_amount = $ ctt - > { int01 } ;
2022-02-20 09:10:00 +01:00
$ reference = $ dbt - > { operator } - > { $ varenv - > { dbname } } - > { oprefix } . "-S-" . $ ctt - > { ct_name } ;
}
#if reference still set then count
2022-09-20 16:13:45 +02:00
if ( $ ctt - > { txt25 } && $ ctt_rec - > { payone_reset } ) {
2022-02-20 09:10:00 +01:00
if ( $ ctt - > { txt25 } =~ /\d-\d$/ ) {
my ( $ refbase , $ sub ) = split ( /-/ , $ ctt - > { txt25 } ) ;
$ sub + + ;
$ reference = "$refbase-$sub" ;
} else {
$ reference = "$ctt->{txt25}-1" ;
}
2022-02-18 20:23:45 +01:00
}
2021-12-30 12:05:56 +01:00
2022-02-18 20:23:45 +01:00
if ( $ ctadr - > { c_id } && $ ctt - > { c_id } && $ preauth_amount > 0 ) {
2021-12-30 12:05:56 +01:00
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 ;
2022-02-18 20:23:45 +01:00
$ amount = $ preauth_amount * 100 if ( $ preauth_amount ) ;
2021-12-30 12:05:56 +01:00
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}" ,
amount = > "$amount" ,
currency = > "$currency" ,
iban = > uc ( $ ctadr - > { txt22 } ) ,
bic = > uc ( $ ctadr - > { txt23 } ) ,
2022-02-20 09:10:00 +01:00
reference = > "$reference"
2021-12-30 12:05:56 +01:00
} ;
2022-10-02 19:26:08 +02:00
$ preauth_request - > { ip } = "$ctadr->{txt25}" if ( $ ctadr - > { txt25 } ) ;
2021-12-30 12:05:56 +01:00
my $ request = { %$ payone_conf , %$ preauth_request } ;
$ payoneret = $ self - > rpc ( "preauthorizationSEPA" , $ varenv , $ request , $ ctadr , $ ctt , $ owner ) if ( $ request ) ;
}
return $ payoneret ;
2022-02-18 20:23:45 +01:00
} #end Request "preauthorizationSEPA"
2021-12-30 12:05:56 +01:00
#Request "captureSEPA"
sub captureSEPA_main {
my $ self = shift ;
my $ varenv = shift ;
my $ ctadr = shift ;
2022-02-17 13:41:16 +01:00
my $ ctt_rec = shift ;
2021-12-30 12:05:56 +01:00
my $ owner = shift || 0 ;
my $ payoneret = "" ;
my $ payone_conf = $ dbt - > { operator } - > { $ varenv - > { dbname } } - > { payone_conf } || $ dbt - > { payone_conf } ;
2022-02-17 13:41:16 +01:00
my $ dbh = "" ;
#to get actual data
my $ pref = {
table = > "contenttrans" ,
fetch = > "one" ,
2022-03-17 20:28:28 +01:00
#template_id => 218,
2022-02-17 13:41:16 +01:00
c_id = > $ ctt_rec - > { c_id } ,
} ;
my $ ctt = { c_id = > 0 } ;
$ ctt = $ dbt - > fetch_record ( $ dbh , $ pref ) ;
2022-02-18 20:23:45 +01:00
my $ TXID = $ ctt - > { txt16 } || "" ;
$ TXID = $ ctt_rec - > { txid } if ( $ ctt_rec - > { txid } ) ;
my $ sequence = 1 ;
$ sequence = $ ctt_rec - > { sequence } if ( $ ctt_rec - > { sequence } ) ;
2022-02-22 18:31:25 +01:00
if ( $ ctt - > { c_id } && ( ! $ ctt - > { state } || $ ctt - > { int14 } || $ ctt_rec - > { payone_reset } ) ) {
my $ amount = 0 ; #if payone_reset capture 0
$ amount = $ ctt - > { int01 } * 100 if ( looks_like_number ( $ ctt - > { int01 } ) && ! $ ctt_rec - > { payone_reset } ) ;
2021-12-30 12:05:56 +01:00
my $ preauth_request = {
request = > 'capture' ,
amount = > "$amount" ,
2022-02-22 18:31:25 +01:00
currency = > "EUR" ,
2022-02-18 20:23:45 +01:00
txid = > "$TXID" ,
sequencenumber = > "$sequence"
2021-12-30 12:05:56 +01:00
} ;
my $ request = { %$ payone_conf , %$ preauth_request } ;
$ payoneret = $ self - > rpc ( "captureSEPA" , $ varenv , $ request , $ ctadr , $ ctt , $ owner ) if ( $ request ) ;
}
return $ payoneret ;
2022-02-18 20:23:45 +01:00
} #end Request "captureSEPA"
2021-12-30 12:05:56 +01:00
#CC
#Request "preauthorizationCC"
sub preauthorizationCC_main {
my $ self = shift ;
my $ varenv = shift ;
my $ ctadr = shift ;
2022-02-17 13:41:16 +01:00
my $ ctt_rec = shift ;
2021-12-30 12:05:56 +01:00
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 ,
2022-02-17 13:41:16 +01:00
c_id = > $ ctt_rec - > { c_id } ,
2021-12-30 12:05:56 +01:00
} ;
2022-02-17 13:41:16 +01:00
my $ ctt = { c_id = > 0 } ;
$ ctt = $ dbt - > fetch_record ( $ dbh , $ pref ) ;
2021-12-30 12:05:56 +01:00
2022-02-22 08:31:35 +01:00
if ( $ ctt_rec - > { payone_reset } ) {
2022-02-17 13:41:16 +01:00
if ( $ ctt - > { ct_name } =~ /\d+-\d+/ ) {
my ( $ ct_name , $ subname ) = split ( /-/ , $ ctt - > { ct_name } ) ;
2021-12-30 12:05:56 +01:00
$ subname + + ;
$ ctt - > { ct_name } = "$ct_name-$subname" ;
} else {
2022-02-17 13:41:16 +01:00
$ ctt - > { ct_name } = "$ctt->{ct_name}-1" ;
2021-12-30 12:05:56 +01:00
}
}
2022-02-18 20:23:45 +01:00
my $ preauth_amount = 0 ;
2022-02-20 09:10:00 +01:00
my $ reference = "" ;
2022-02-18 20:23:45 +01:00
#for testing payment-data
if ( $ ctt_rec - > { c_id } && $ ctt_rec - > { c_id } == 1 && $ ctt_rec - > { reference } ) {
$ ctt = $ ctt_rec ;
$ preauth_amount = $ ctt - > { int15 } ; #int15 should only used for testing payment-data
2022-02-20 09:10:00 +01:00
$ reference = $ ctt_rec - > { reference } ;
2022-02-18 20:23:45 +01:00
} else {
$ preauth_amount = $ ctt - > { int01 } ;
2022-02-20 09:10:00 +01:00
$ reference = $ dbt - > { operator } - > { $ varenv - > { dbname } } - > { oprefix } . "-C-" . $ ctt - > { ct_name } ;
}
#if reference still set then count
2022-09-20 16:13:45 +02:00
if ( $ ctt - > { txt25 } && $ ctt_rec - > { payone_reset } ) {
2022-02-20 09:10:00 +01:00
if ( $ ctt - > { txt25 } =~ /\d-\d$/ ) {
my ( $ refbase , $ sub ) = split ( /-/ , $ ctt - > { txt25 } ) ;
$ sub + + ;
$ reference = "$refbase-$sub" ;
} else {
$ reference = "$ctt->{txt25}-1" ;
}
2022-02-18 20:23:45 +01:00
}
2021-12-30 12:05:56 +01:00
2022-02-18 20:23:45 +01:00
if ( $ ctadr - > { c_id } && $ ctt - > { c_id } && $ preauth_amount > 0 ) {
2021-12-30 12:05:56 +01:00
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 ;
2022-02-18 20:23:45 +01:00
$ amount = $ preauth_amount * 100 if ( $ preauth_amount ) ;
2021-12-30 12:05:56 +01:00
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}" ,
amount = > "$amount" ,
currency = > 'EUR' ,
pseudocardpan = > "$ctadr->{ct_name}" ,
ecommercemode = > "internet" , # wird zu 3Dscheck,
2022-02-20 09:10:00 +01:00
reference = > "$reference"
2021-12-30 12:05:56 +01:00
} ;
# 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
2022-10-02 19:26:08 +02:00
$ preauth_request - > { ip } = "$ctadr->{txt25}" if ( $ ctadr - > { txt25 } ) ;
2021-12-30 12:05:56 +01:00
my $ request = { %$ payone_conf , %$ preauth_request } ;
$ payoneret = $ self - > rpc ( "preauthorizationCC" , $ varenv , $ request , $ ctadr , $ ctt , $ owner ) if ( $ request ) ;
}
return $ payoneret ;
2022-02-18 20:23:45 +01:00
} #end Request "preauthorizationCC"
2021-12-30 12:05:56 +01:00
#Request "captureCC"
sub captureCC_main {
my $ self = shift ;
my $ varenv = shift ;
my $ ctadr = shift ;
2022-02-17 13:41:16 +01:00
my $ ctt_rec = shift ;
2021-12-30 12:05:56 +01:00
my $ owner = shift || 0 ;
my $ payoneret = "" ;
my $ payone_conf = $ dbt - > { operator } - > { $ varenv - > { dbname } } - > { payone_conf } || $ dbt - > { payone_conf } ;
2022-02-17 13:41:16 +01:00
my $ dbh = "" ;
#to get actual data
my $ pref = {
table = > "contenttrans" ,
fetch = > "one" ,
2022-03-17 20:28:28 +01:00
#template_id => 218,
2022-02-17 13:41:16 +01:00
c_id = > $ ctt_rec - > { c_id } ,
} ;
my $ ctt = { c_id = > 0 } ;
$ ctt = $ dbt - > fetch_record ( $ dbh , $ pref ) ;
2022-02-18 20:23:45 +01:00
my $ TXID = $ ctt - > { txt16 } ;
$ TXID = $ ctt_rec - > { txid } if ( $ ctt_rec - > { txid } ) ;
my $ sequence = 1 ;
$ sequence = $ ctt_rec - > { sequence } if ( $ ctt_rec - > { sequence } ) ;
2021-12-30 12:05:56 +01:00
2022-02-22 18:31:25 +01:00
if ( $ ctt - > { c_id } && ( ! $ ctt - > { state } || $ ctt - > { int14 } || $ ctt_rec - > { payone_reset } ) ) {
my $ amount = 0 ; #if payone_reset capture 0
$ amount = $ ctt - > { int01 } * 100 if ( looks_like_number ( $ ctt - > { int01 } ) && ! $ ctt_rec - > { payone_reset } ) ;
2021-12-30 12:05:56 +01:00
my $ preauth_request = {
request = > 'capture' ,
amount = > "$amount" ,
currency = > 'EUR' ,
2022-02-18 20:23:45 +01:00
txid = > "$TXID" ,
sequencenumber = > "$sequence"
2021-12-30 12:05:56 +01:00
} ;
my $ request = { %$ payone_conf , %$ preauth_request } ;
$ payoneret = $ self - > rpc ( "captureCC" , $ varenv , $ request , $ ctadr , $ ctt , $ owner ) if ( $ request ) ;
}
return $ payoneret ;
2022-02-18 20:23:45 +01:00
} #end Request "captureCC"
2021-12-30 12:05:56 +01:00
#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 ) ;
2022-01-16 12:17:11 +01:00
2021-12-30 12:05:56 +01:00
my $ vde_on_fail = $ ctadr - > { int12 } || 1 ; #keep last or set 1
my $ debug = 0 ;
$ debug = 1 ;
my $ update_adr = {
table = > "contentadr" ,
2022-02-23 12:33:59 +01:00
#mtime => "now()",
#owner => $owner
2021-12-30 12:05:56 +01:00
} ;
my $ update_ctt = {
table = > "contenttrans" ,
mtime = > "now()" ,
owner = > $ owner
} ;
2022-01-16 12:17:11 +01:00
my $ now_dt = strftime "%Y-%m-%d %H:%M:%S" , localtime ;
2021-12-30 12:05:56 +01:00
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 ;
2022-01-16 12:17:11 +01:00
print FILE "payone MANDATE $now_dt\n mival: $mival && $ctadr->{c_id}\n" if ( $ debug ) ;
2021-12-30 12:05:56 +01:00
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 ;
2022-01-16 12:17:11 +01:00
print FILE "payone PREAUTH $now_dt\n $todo: $txidval && $ctt->{c_id} && $ctadr->{c_id}\n" if ( $ debug ) ;
2021-12-30 12:05:56 +01:00
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 - > { int17 } = $ useridval if ( $ useridval ) ;
$ update_ctt - > { txt16 } = $ txidval ;
2022-02-22 08:31:35 +01:00
$ update_ctt - > { txt22 } = $ ctt - > { payone_reset } if ( $ ctt - > { payone_reset } ) ;
2021-12-30 12:05:56 +01:00
$ 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 ;
2022-01-16 12:17:11 +01:00
print FILE "payone CAPTURE $now_dt\n $todo: txid=$txidval && ctt.c_id=$ctt->{c_id} && ctadr.c_id=$ctadr->{c_id}\n" if ( $ debug ) ;
2021-12-30 12:05:56 +01:00
if ( $ txidval && $ ctt - > { c_id } && $ ctadr - > { c_id } && $ res - > content =~ /settleaccount=/ ) {
2022-02-18 20:23:45 +01:00
#int01 and state will be set by "buchen" via Prelogic or via payone_cron/Payment payone_capture
2021-12-30 12:05:56 +01:00
$ 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
2022-01-16 12:17:11 +01:00
print FILE "NOT APPROVED $now_dt\n $todo: ctt.c_id=$ctt->{c_id} && ctadr.c_id=$ctadr->{c_id}" . $ res - > content . "\n" if ( $ debug ) ;
2022-02-22 08:31:35 +01:00
$ update_ctt - > { int14 } = 1 if ( $ ctt - > { state } ) ; #OPOS
2021-12-30 12:05:56 +01:00
#errormessage=Reference number already exists --> disabled
#errormessage=Amount no longer available --> disabled
if ( $ res - > content !~ /errorcode=911/ ) {
2022-02-19 13:20:23 +01:00
my $ payone_message = "$now_dt\n" . $ res - > content . "\nAufgrund der payone Ablehnung wurde der Verleih gesperrt.\n" ;
2021-12-30 12:05:56 +01:00
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 ) ;
}
2022-01-16 12:17:11 +01:00
print FILE "payone RPC end\n\n" if ( $ debug ) ;
2021-12-30 12:05:56 +01:00
close ( FILE ) if ( $ debug ) ;
2022-02-23 12:33:59 +01:00
#set contentadr owner and mtime only if Vde or error will be set by payone id's
if ( ( ( $ update_adr - > { int12 } && $ update_adr - > { int12 } > 0 ) || $ update_adr - > { txt28 } ) && ( $ owner == 178 || $ owner == 179 ) ) {
$ update_adr - > { owner } = "$owner" ;
$ update_adr - > { mtime } = "now()" ;
}
2021-12-30 12:05:56 +01:00
$ 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 {
2022-11-14 21:16:22 +01:00
my $ self = shift ;
my $ varenv = shift ;
my $ c_id = shift || 0 ;
my $ api_file = "/var/www/copri4/shareeconf/apikeys.cfg" ;
my $ aconf = Config::General - > new ( $ api_file ) ;
my % apikeyconf = $ aconf - > getall ;
my $ dbh = "" ;
my $ authref = {
2021-12-30 12:05:56 +01:00
table = > "contentadr" ,
fetch = > "one" ,
template_id = > "202" ,
c_id = > "$c_id" ,
} ;
my $ ctadr = $ dbt - > fetch_record ( $ dbh , $ authref ) ;
2022-01-16 12:17:11 +01:00
my $ now_dt = strftime "%Y-%m-%d %H:%M:%S" , localtime ;
2022-02-14 16:06:02 +01:00
open ( EMA , ">> $varenv->{logdir}/copri-print.log" ) ;
2021-12-30 12:05:56 +01:00
print EMA "*** $now_dt trying pdf --> $varenv->{basedir}/pdfinvoice/SEPA-Lastschriftmandat-$varenv->{dbname}-$ctadr->{ct_name}.pdf && $ctadr->{txt27}\n" ;
2022-02-01 20:53:23 +01:00
if ( $ ctadr - > { txt27 } && $ ctadr - > { txt27 } =~ /active|pending/ ) {
2021-12-30 12:05:56 +01:00
my $ topdf = "$varenv->{basedir}/src/wkhtmltopdf-amd64" ;
2022-11-14 21:16:22 +01:00
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}\&pkey=$apikeyconf{pdfprinter}->{pkey}" $varenv->{basedir}/pdfinvoice/SEPA-Lastschriftmandat-$varenv->{dbname}-$ctadr->{ct_name}.pdf 2>&1` ;
2021-12-30 12:05:56 +01:00
my $ exit_code = $? ;
my $ filesize = - s "$varenv->{basedir}/pdfinvoice/SEPA-Lastschriftmandat-$varenv->{dbname}-$ctadr->{ct_name}.pdf" ;
2022-11-14 21:16:22 +01:00
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}\&pkey=$apikeyconf{pdfprinter}->{pkey}' $varenv->{basedir}/pdfinvoice/SEPA-Lastschriftmandat-$varenv->{dbname}-$ctadr->{ct_name}.pdf\nreturn: $print_return\nfilesize: $filesize\nexit_code: $exit_code\n" ;
2021-12-30 12:05:56 +01:00
}
close EMA ;
2022-04-02 20:28:45 +02:00
return "$varenv->{basedir}/pdfinvoice/SEPA-Lastschriftmandat-$varenv->{dbname}-$ctadr->{ct_name}.pdf" ;
2021-12-30 12:05:56 +01:00
}
#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 ;
2022-02-14 16:06:02 +01:00
#my $main_id = 300008;#Rechnung
my $ main_id = $ ctt - > { main_id } ;
my $ retval = "" ;
my $ return_text = "" ;
2021-12-30 12:05:56 +01:00
my $ dbh = "" ;
2022-11-14 21:16:22 +01:00
my $ api_file = "/var/www/copri4/shareeconf/apikeys.cfg" ;
my $ aconf = Config::General - > new ( $ api_file ) ;
my % apikeyconf = $ aconf - > getall ;
2021-12-30 12:05:56 +01:00
2022-07-13 11:19:55 +02:00
my $ update_ctt = {
table = > "contenttrans" ,
mtime = > "now()" ,
owner = > $ owner ,
int01 = > $ sum_paid ,
int14 = > 2 ,
} ;
2022-10-14 08:28:51 +02:00
my $ node_faktura = $ dbt - > get_node ( $ dbh , $ dbt - > { shareedms_conf } - > { faktura } ) ;
2022-07-13 11:19:55 +02:00
my $ node = $ dbt - > get_node ( $ dbh , $ main_id ) ; #Rechnung node
2022-10-14 08:28:51 +02:00
if ( $ node_faktura - > { invoice_nr } > 0 ) {
2021-12-30 12:05:56 +01:00
if ( $ ctt - > { ct_name } !~ /\d/ ) {
2022-10-14 08:28:51 +02:00
my $ nextNr = $ node_faktura - > { invoice_nr } ;
2022-07-13 11:19:55 +02:00
$ update_ctt - > { ct_name } = "$nextNr" ;
$ update_ctt - > { barcode } = "$nextNr" ;
my $ update_node = {
table = > "nodes" ,
2022-10-14 08:28:51 +02:00
main_id = > "$dbt->{shareedms_conf}->{faktura}" ,
2022-07-13 11:19:55 +02:00
change = > "no_time" ,
} ;
2022-10-14 08:28:51 +02:00
my $ invoice_nr = $ node_faktura - > { invoice_nr } + 1 ;
2022-07-13 11:19:55 +02:00
$ dbt - > update_one ( $ dbh , $ update_node , "invoice_nr='$invoice_nr'" ) ;
2021-12-30 12:05:56 +01:00
}
} else {
2022-10-14 08:28:51 +02:00
$ return_text = "payone_cron Payment.pm exit, $node_faktura->{invoice_nr} | $ctt->{ct_name} can not generate invoice number\n" ;
2021-12-30 12:05:56 +01:00
return $ return_text ;
}
my $ state = $ ctt - > { state } ;
2022-10-14 08:28:51 +02:00
if ( $ dbt - > { shareedms_conf } - > { payment_state } ) {
my @ _paymentstate = split ( /\|/ , $ dbt - > { shareedms_conf } - > { payment_state } ) ;
2021-12-30 12:05:56 +01:00
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 ] ;
}
}
2022-07-13 11:19:55 +02:00
$ update_ctt - > { state } = "$state" ;
2022-02-22 08:31:35 +01:00
$ dbt - > update_record ( $ dbh , $ update_ctt , $ ctt ) ;
2021-12-30 12:05:56 +01:00
#in cron we set OPOS anyway. If payone captured, it will be set int14=null
if ( ! $ state || $ state !~ /payone/ ) {
2022-02-14 16:06:02 +01:00
$ 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" ;
2021-12-30 12:05:56 +01:00
return $ return_text ;
}
#preauth
2022-02-17 13:41:16 +01:00
if ( $ ctadr - > { int03 } && $ ctadr - > { int03 } == 1 && $ ctadr - > { ct_name } && $ ctadr - > { ct_name } =~ /\w{2}-\d+/ && ! $ ctt - > { txt16 } ) {
2021-12-30 12:05:56 +01:00
$ self - > preauthorizationSEPA_main ( $ varenv , $ ctadr , $ ctt , $ owner ) ;
sleep 2 ;
2022-02-17 13:41:16 +01:00
} elsif ( $ ctadr - > { int03 } && $ ctadr - > { int03 } == 2 && $ ctadr - > { ct_name } && length ( $ ctadr - > { ct_name } ) >= 19 && ! $ ctt - > { txt16 } ) {
2021-12-30 12:05:56 +01:00
$ self - > preauthorizationCC_main ( $ varenv , $ ctadr , $ ctt , $ owner ) ;
sleep 2 ;
}
#check if preauth txid is done by payone
2022-07-13 11:19:55 +02:00
my $ pref = {
table = > "contenttrans" ,
fetch = > "one" ,
template_id = > 218 ,
c_id = > $ ctt - > { c_id } ,
} ;
$ ctt = $ dbt - > fetch_record ( $ dbh , $ pref ) ;
2021-12-30 12:05:56 +01:00
#SEPA capture
2022-08-01 15:13:43 +02:00
if ( $ ctadr - > { int03 } == 1 && $ ctt - > { txt16 } && $ ctt - > { state } =~ /SEPA/ ) { #SEPA
2021-12-30 12:05:56 +01:00
$ self - > captureSEPA_main ( $ varenv , $ ctadr , $ ctt , $ owner ) ;
}
#CC capture
2022-08-01 15:13:43 +02:00
elsif ( $ ctadr - > { int03 } == 2 && $ ctt - > { txt16 } && $ ctt - > { state } =~ /Kreditkarte/ ) { #CC
2021-12-30 12:05:56 +01:00
$ self - > captureCC_main ( $ varenv , $ ctadr , $ ctt , $ owner ) ;
}
2022-02-14 16:06:02 +01:00
else {
2022-08-01 15:13:43 +02:00
$ return_text = "Payment.pm can not get TXID ($ctadr->{int03} && $ctadr->{ct_name} && TXID:$ctt->{txt16})\n" ;
2021-12-30 12:05:56 +01:00
}
#wkhtml
if ( 1 == 1 ) {
2022-02-14 16:06:02 +01:00
my $ praefix = "$ctt->{txt00}-$varenv->{praefix}" ; #like Rechnung-sharee_operator
2021-12-30 12:05:56 +01:00
my $ topdf = "$varenv->{basedir}/src/wkhtmltopdf-amd64" ;
2022-02-19 13:20:23 +01:00
my $ exit_code = 1 ;
my $ print_return = "" ;
2022-11-14 21:16:22 +01:00
$ 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\&pkey=$apikeyconf{pdfprinter}->{pkey}" $varenv->{pdf}/$praefix-$ctt->{ct_name}.pdf 2>&1` ;
2022-02-19 13:20:23 +01:00
$ exit_code = $? ;
sleep 2 ;
2021-12-30 12:05:56 +01:00
2022-02-14 16:06:02 +01:00
my $ now_dt = strftime "%Y-%m-%d %H:%M:%S" , localtime ;
2022-02-19 13:20:23 +01:00
my $ filesize = - s "$varenv->{pdf}/$praefix-$ctt->{ct_name}.pdf" ;
2022-02-14 16:06:02 +01:00
open ( EMA , ">> $varenv->{logdir}/copri-print.log" ) ;
2022-11-14 21:16:22 +01:00
print EMA "\n$now_dt\n$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\&pkey=$apikeyconf{pdfprinter}->{pkey}\" $varenv->{pdf}/$praefix-$ctt->{ct_name}.pdf\nreturn: $print_return\nfilesize: $filesize\nexit_code: $exit_code\n" ;
2021-12-30 12:05:56 +01:00
2022-05-04 08:02:59 +02:00
#send_invoice infomail, only if eMail never sent
if ( - f "$varenv->{pdf}/$praefix-$ctt->{ct_name}.pdf" && ! $ ctt - > { txt30 } ) {
system ( "$varenv->{basedir}/src/scripts/mailTransport.pl '$varenv->{syshost}' 'send_invoice' '$ctt->{c_id}' '$praefix-$ctt->{ct_name}.pdf'" ) ;
2022-02-16 15:56:45 +01:00
print EMA "---> Sent Invoice e-mail command: $varenv->{basedir}/src/scripts/mailTransport.pl '$varenv->{syshost}' 'send_invoice' '$ctt->{c_id}' '$praefix-$ctt->{ct_name}.pdf'\n" ;
2022-02-14 16:06:02 +01:00
}
close EMA ;
2021-12-30 12:05:56 +01:00
}
2022-02-14 16:06:02 +01:00
2021-12-30 12:05:56 +01:00
return ( $ retval , $ return_text ) ;
}
1 ;