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
#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" ) ;
#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 ) ;
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" ,
mtime = > "now()" ,
owner = > $ owner
} ;
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 - > { 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 ;
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=/ ) {
#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
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 ) ;
2021-12-30 12:05:56 +01:00
$ 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 ) ;
}
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 ) ;
$ 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 ) ;
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 ( 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" ;
2022-02-01 20:53:23 +01:00
#if((! -f "$varenv->{basedir}/pdfinvoice/SEPA-Lastschriftmandat-$varenv->{dbname}-$ctadr->{ct_name}.pdf") && $ctadr->{txt27} && $ctadr->{txt27} =~ /active|pending/){
if ( $ ctadr - > { txt27 } && $ ctadr - > { txt27 } =~ /active|pending/ ) {
2021-12-30 12:05:56 +01:00
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 ;
