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
#
#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 ;
2023-12-19 05:13:56 +01:00
use CGI ;
2024-01-09 07:27:19 +01:00
use Digest::SHA qw( hmac_sha256 hmac_sha256_base64 ) ;
2023-12-19 05:13:56 +01:00
use JSON ;
my $ json = JSON - > new - > allow_nonref ;
2021-12-30 12:05:56 +01:00
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::DBtank ;
use Mod::Basework ;
2024-01-09 07:27:19 +01:00
use Mod::RPCshareeio ;
2021-12-30 12:05:56 +01:00
use Data::Dumper ;
my $ q = new CGI ;
my $ cf = new Config ;
my $ dbt = new DBtank ;
2024-01-09 07:27:19 +01:00
my $ rpcs = new RPCshareeio ;
2021-12-30 12:05:56 +01:00
my $ bw = new Basework ;
sub new {
my $ class = shift ;
my $ self = { } ;
bless ( $ self , $ class ) ;
return $ self ;
}
2023-11-16 20:11:13 +01:00
#book_payment is like payone_capture with additional payment-types
sub book_payment {
my $ self = shift ;
my $ q = shift ;
my $ varenv = shift ;
my $ node_meta = shift ;
my $ users_dms = shift ;
$ q - > import_names ( 'R' ) ;
my $ dbh = "" ;
my $ feedb = {
u_rows = > 0 ,
message = > "" ,
exit_code = > 1 ,
} ;
my $ now_dt = strftime "%Y-%m-%d %H:%M:%S" , localtime ;
open ( EMA , ">> $varenv->{logdir}/book_payment.log" ) ;
2024-01-09 07:27:19 +01:00
print EMA "\n*** $now_dt book_payment invoice c_id4trans:$R::c_id4trans\n" . Dumper ( $ q ) . "\n" ;
2023-11-16 20:11:13 +01:00
my $ pref_ctt = {
table = > "contenttrans" ,
fetch = > "one" ,
c_id = > $ R:: c_id4trans ,
} ;
my $ ctt = { c_id = > 0 } ;
$ ctt = $ dbt - > fetch_record ( $ dbh , $ pref_ctt ) if ( $ R:: c_id4trans ) ;
2024-01-09 07:27:19 +01:00
my $ update_adr = {
table = > "contentadr" ,
mtime = > "now()" ,
owner = > $ users_dms - > { u_id } ,
} ;
2023-11-16 20:11:13 +01:00
my $ update_ctt = {
table = > "contenttrans" ,
mtime = > "now()" ,
owner = > $ users_dms - > { u_id } ,
2024-01-16 06:23:43 +01:00
int04 = > 0 ,
2023-11-16 20:11:13 +01:00
} ;
my $ node_faktura = $ dbt - > get_node ( $ dbh , $ dbt - > { shareedms_conf } - > { faktura } ) ;
#invoice number counter. Take last number from node.invoice_nr and increment it
if ( $ node_faktura - > { invoice_nr } > 0 && $ ctt - > { c_id } && $ ctt - > { ct_name } !~ /\d/ ) {
my $ nextNr = $ node_faktura - > { invoice_nr } ;
$ update_ctt - > { ct_name } = "$nextNr" ;
$ update_ctt - > { barcode } = "$nextNr" ;
my $ update_node = {
table = > "nodes" ,
main_id = > "$dbt->{shareedms_conf}->{faktura}" ,
change = > "no_time" ,
} ;
my $ invoice_nr = $ node_faktura - > { invoice_nr } + 1 ;
$ dbt - > update_one ( $ dbh , $ update_node , "invoice_nr='$invoice_nr'" ) ;
}
print EMA "Used invoice c_id:$ctt->{c_id} with invoice nr:$ctt->{ct_name} OR nextNr: $update_ctt->{ct_name}\n" ;
#Set sum values and book payment depending by selected payment-type "state"
if ( $ ctt - > { c_id } && ! $ ctt - > { close_time } ) {
my $ pref_adr = {
table = > "contentadr" ,
fetch = > "one" ,
c_id = > $ ctt - > { int10 } ,
} ;
my $ ctadr = { c_id = > 0 } ;
$ ctadr = $ dbt - > fetch_tablerecord ( $ dbh , $ pref_adr ) if ( $ ctt - > { int10 } ) ;
2024-01-09 07:27:19 +01:00
my $ vde_on_fail = $ ctadr - > { int12 } || 1 ; #keep last or set 1
2023-11-16 20:11:13 +01:00
my $ sum_paid = "null" ;
my $ sum_operatorcredit = "null" ;
my $ sumgeb_teil = "null" ;
my $ sumgeb_bank = "null" ;
2024-01-09 07:27:19 +01:00
my $ sum_prepaid = "null" ;
2024-01-16 06:23:43 +01:00
$ update_ctt - > { int04 } = $ R:: int04 if ( looks_like_number ( $ R:: int04 ) ) ; #set payment-type by "buchen"
2023-11-16 20:11:13 +01:00
$ update_ctt - > { int14 } = 2 ; #set OPOS
2024-01-16 06:23:43 +01:00
my $ p_hash = $ dbt - > { shareedms_conf } - > { payment_state2 } ;
my $ state = $ p_hash - > { $ update_ctt - > { int04 } } ;
$ update_ctt - > { state } = "$state" ; #save it also to keep backwards compatibility
print EMA "Payment-type $p_hash->{$update_ctt->{int04}} used adr c_id:$ctadr->{c_id} by ctt.int10: $ctt->{int10}\n" ;
2023-11-16 20:11:13 +01:00
if ( $ R:: sum_paid ) {
$ sum_paid = $ R:: sum_paid ;
$ sum_paid =~ s/,/\./ ;
$ update_ctt - > { int01 } = $ sum_paid ;
2021-12-30 12:05:56 +01:00
}
2023-11-16 20:11:13 +01:00
if ( $ R:: sum_operatorcredit ) {
$ sum_operatorcredit = $ R:: sum_operatorcredit ;
$ sum_operatorcredit =~ s/,/\./ ;
$ update_ctt - > { int02 } = $ sum_operatorcredit ;
$ update_ctt - > { int14 } = "null" ;
}
2024-01-09 07:27:19 +01:00
if ( $ R:: sumgeb_bank ) {
$ sumgeb_bank = $ R:: sumgeb_bank ;
$ sumgeb_bank =~ s/,/\./ ;
$ update_ctt - > { int07 } = $ sumgeb_bank ;
}
2023-11-16 20:11:13 +01:00
if ( $ R:: sumgeb_teil ) {
$ sumgeb_teil = $ R:: sumgeb_teil ;
$ sumgeb_teil =~ s/,/\./ ;
$ update_ctt - > { int08 } = $ sumgeb_teil ;
}
2024-01-16 06:23:43 +01:00
#maybe, we don't need it
2024-01-09 07:27:19 +01:00
if ( $ R:: sum_prepaid ) {
$ sum_prepaid = $ R:: sum_prepaid ;
$ sum_prepaid =~ s/,/\./ ;
#$update_ctt->{int09} = $sum_prepaid;
2023-11-16 20:11:13 +01:00
}
$ feedb - > { u_rows } = $ dbt - > update_record ( $ dbh , $ update_ctt , $ ctt ) ;
2024-01-16 06:23:43 +01:00
#if payment-type payone
if ( $ update_ctt - > { int04 } && $ update_ctt - > { int04 } <= 2 ) {
2023-11-16 20:11:13 +01:00
if ( ! $ ctt - > { txt16 } ) {
#preauth
if ( $ ctadr - > { ct_name } =~ /\w{2}-\d+/ ) {
my $ payoneret = $ self - > preauthorizationSEPA_main ( $ varenv , $ ctadr , $ ctt , $ users_dms - > { u_id } ) ;
sleep 2 ;
} elsif ( length ( $ ctadr - > { ct_name } ) >= 19 ) {
my $ payoneret = $ self - > preauthorizationCC_main ( $ varenv , $ ctadr , $ ctt , $ users_dms - > { u_id } ) ;
sleep 2 ;
}
$ ctt = $ dbt - > fetch_record ( $ dbh , $ pref_ctt ) ; #re-read values
#SEPA capture
2024-01-16 06:23:43 +01:00
if ( $ ctt - > { txt16 } && $ update_ctt - > { int04 } == 1 ) { #SEPA
2023-11-16 20:11:13 +01:00
my $ payoneret = $ self - > captureSEPA_main ( $ varenv , $ ctadr , $ ctt , $ users_dms - > { u_id } ) ;
}
#CC capture
2024-01-16 06:23:43 +01:00
elsif ( $ ctt - > { txt16 } && $ update_ctt - > { int04 } == 2 ) { #CC
2023-11-16 20:11:13 +01:00
my $ payoneret = $ self - > captureCC_main ( $ varenv , $ ctadr , $ ctt , $ users_dms - > { u_id } ) ;
}
else {
2024-01-16 06:23:43 +01:00
$ feedb - > { message } = "failure::Achtung, die payone Vorautorisierung hat keine TXID geliefert. Der Geldeinzug war somit nicht möglich (TXID:$ctt->{txt16} && state: $update_ctt->{int04}|$state)." ;
2023-11-16 20:11:13 +01:00
}
} else {
$ feedb - > { message } = "failure::Abbruch, payone Geldeinzug nicht ausgeführt weil TXID bereits vorhanden. Hatte der Einzug bereits stattgefunden?" ;
}
}
2024-01-16 06:23:43 +01:00
#Storno or Zahlungsausfall
elsif ( $ ctt - > { txt00 } eq "Storno" || $ update_ctt - > { int04 } == 7 ) {
2023-11-16 20:11:13 +01:00
$ update_ctt - > { int14 } = "null" ;
$ update_ctt - > { pay_time } = "now()" ;
$ feedb - > { u_rows } = $ dbt - > update_record ( $ dbh , $ update_ctt , $ ctt ) ;
#delete OPOS at all
2023-12-01 20:14:31 +01:00
$ update_ctt - > { barcode } = $ ctt - > { barcode } ;
if ( $ update_ctt - > { barcode } ) {
$ dbt - > update_one ( $ dbh , $ update_ctt , "int14=null" ) ;
} else {
$ feedb - > { message } = "failure::Fehler, OPOS Automatik konnte nicht ausgeführt werden." ;
}
2024-01-16 06:23:43 +01:00
if ( $ update_ctt - > { int04 } == 7 ) {
$ update_adr - > { int12 } = 2 ; #vde
$ dbt - > update_record ( $ dbh , $ update_adr , $ ctadr ) ;
my $ dbh_primary = $ dbt - > dbconnect_extern ( $ dbt - > { primary } - > { sharee_primary } - > { database } - > { dbname } ) ;
$ dbt - > update_record ( $ dbh_primary , $ update_adr , $ ctadr ) ;
}
2023-11-16 20:11:13 +01:00
}
2024-01-16 06:23:43 +01:00
#fehlgeschlagener Einzug
elsif ( $ update_ctt - > { int04 } == 6 ) {
2023-11-16 20:11:13 +01:00
$ update_ctt - > { int14 } = "null" ;
$ update_ctt - > { pay_time } = "now()" ;
$ feedb - > { u_rows } = $ dbt - > update_record ( $ dbh , $ update_ctt , $ ctt ) ;
}
elsif ( $ ctt - > { txt00 } eq "Rechnung" && $ R:: sum_paid <= 0 ) {
$ update_ctt - > { int14 } = "null" ;
$ update_ctt - > { pay_time } = "now()" ;
$ feedb - > { u_rows } = $ dbt - > update_record ( $ dbh , $ update_ctt , $ ctt ) ;
}
2024-01-16 06:23:43 +01:00
#Prepaid
elsif ( $ update_ctt - > { int04 } == 3 && $ ctadr - > { c_id } ) {
2024-01-09 07:27:19 +01:00
#APIshareeio APIcall
my $ shareeio_json = {
request = > "capture_prepaid" ,
userID = > "$ctadr->{c_id}" ,
sum_paid = > "$update_ctt->{int01}" ,
invoice_reference = > "$dbt->{operator}->{$varenv->{dbname}}->{oprefix}-$ctt->{c_id}-$ctt->{ct_name}" ,
} ;
my $ response_in = { } ;
$ response_in = $ rpcs - > request_shareeio ( $ varenv , $ dbh , $ ctadr , $ shareeio_json ) ;
if ( $ response_in - > { shareeio } - > { response_state } =~ /Success/i ) {
$ update_ctt - > { int14 } = "null" ;
$ update_ctt - > { pay_time } = "now()" ;
$ update_adr - > { int12 } = "null" ;
} else {
$ update_adr - > { int12 } = $ vde_on_fail ; #Vde
}
$ update_ctt - > { txt28 } = $ now_dt . " $state\n" . $ response_in - > { shareeio } - > { response_state } . "\n\n" . $ ctt - > { txt28 } ;
$ feedb - > { u_rows } = $ dbt - > update_record ( $ dbh , $ update_ctt , $ ctt ) ;
$ dbt - > update_record ( $ dbh , $ update_adr , $ ctadr ) ;
my $ dbh_primary = $ dbt - > dbconnect_extern ( $ dbt - > { primary } - > { sharee_primary } - > { database } - > { dbname } ) ;
$ dbt - > update_record ( $ dbh_primary , $ update_adr , $ ctadr ) ;
}
2023-11-16 20:11:13 +01:00
$ ctt = $ dbt - > fetch_record ( $ dbh , $ pref_ctt ) ; #re-read values
#print pdf and messaging
if ( $ ctt - > { c_id } ) {
my $ praefix = "$ctt->{txt00}-$varenv->{praefix}" ;
my $ lang_ctt = $ ctt - > { txt11 } || "de" ;
$ varenv - > { cms } = $ dbt - > fetch_cms ( $ dbh , { lang = > $ lang_ctt } ) ;
my $ sum_paid = $ R:: sum_paid || 0 ;
$ sum_paid =~ s/,/\./ ;
#print pdf
if ( $ R:: print_pdf ) {
$ feedb = $ self - > print_pdf ( $ q , $ varenv , $ node_meta , $ users_dms , $ feedb ) ;
}
#send_invoice after book payment
if ( - f "$varenv->{basedir}/pdfinvoice/$praefix-$ctt->{ct_name}.pdf" && ( ( $ R:: set_state eq "buchen" && $ R:: send_invoice && $ ctt - > { int01 } && $ ctt - > { int01 } != 0 ) || ( $ R:: send_invoice_again ) ) ) {
my $ cms_message_key = "email-invoice" ;
if ( ! $ varenv - > { cms } - > { $ cms_message_key } - > { txt } ) {
$ feedb - > { message } = "failure::Achtung, CMS-Text '$cms_message_key' ist nicht vorhanden. Es wurde keine eMail versandt!" ;
} elsif ( $ sum_paid != $ ctt - > { int01 } ) {
$ feedb - > { message } = "failure::Achtung, die Summe der Positionen $sum_paid enstpricht nicht der Rechnung-Summe $ctt->{int01}. Die Rechnung muss vor dem eMail versand erst gebucht werden!" ;
} else {
system ( "$dbt->{copri_conf}->{basedir}/$varenv->{syshost}/src/scripts/mailTransportcms.pl '$varenv->{syshost}' 'send_invoice' '$ctt->{int10}' '$ctt->{c_id}' '' '$cms_message_key' '1'" ) ;
print EMA "---> send_invoice $praefix-$ctt->{ct_name}.pdf email command: $dbt->{copri_conf}->{basedir}/$varenv->{syshost}/src/scripts/mailTransportcms.pl '$varenv->{syshost}' 'send_invoice' '$ctt->{int10}' '$ctt->{c_id}' '' '$cms_message_key' '1'\n" ;
}
}
} #end print pdf and messaging
} else {
$ feedb - > { message } = "failure::Buchung abbgebrochen. Die Rechnung ist bereits abgeschlossen oder nicht vorhanden ($ctt->{c_id} > 0 && $ctt->{ct_name} && !$ctt->{close_time})" ;
}
2021-12-30 12:05:56 +01:00
2023-11-16 20:11:13 +01:00
close EMA ;
return $ feedb ;
} #end book_payment
#print pdf
sub print_pdf {
my $ self = shift ;
my $ q = shift ;
my $ varenv = shift ;
my $ node_meta = shift ;
my $ users_dms = shift ;
my $ feedb = shift ;
$ q - > import_names ( 'R' ) ;
my $ dbh = "" ;
my $ pref_ctt = {
table = > "contenttrans" ,
fetch = > "one" ,
c_id = > $ R:: c_id4trans ,
} ;
my $ ctt = { c_id = > 0 } ;
$ ctt = $ dbt - > fetch_record ( $ dbh , $ pref_ctt ) if ( $ R:: c_id4trans ) ;
open ( EMA , ">> $varenv->{logdir}/copri-print.log" ) ;
if ( $ ctt - > { c_id } ) {
my $ api_file = "/var/www/copri4/shareeconf/apikeys.cfg" ;
my $ aconf = Config::General - > new ( $ api_file ) ;
my % apikeyconf = $ aconf - > getall ;
my $ mandant_id = 100002 ;
my $ print_return = "" ;
my $ lang_ctt = $ ctt - > { txt11 } || "de" ;
my $ praefix = "$ctt->{txt00}-$varenv->{praefix}" ;
my $ psize = "A4" ;
my $ topdf = "$varenv->{basedir}/src/wkhtmltopdf-amd64" ;
#without system() because we have to wait until PDF is ready
$ print_return = `$topdf --page-size $psize "$varenv->{wwwhost}/Printpreview?printer_id=PDF\&mandant_main_id=$mandant_id\&main_id=$node_meta->{main_id}\&ct_name2print=$ctt->{ct_name}\&c_id4trans=$ctt->{c_id}\&u_id=$users_dms->{u_id}\&pkey=$apikeyconf{pdfprinter}->{pkey}" "$varenv->{pdf}/$praefix-$ctt->{ct_name}.pdf" 2>&1` ;
$ feedb - > { exit_code } = $? ;
my $ filesize = - s "$varenv->{pdf}/$praefix-$ctt->{ct_name}.pdf" ;
print EMA "$topdf --page-size $psize $varenv->{wwwhost}/Printpreview?printer_id=PDF\&mandant_main_id=$mandant_id\&main_id=$node_meta->{main_id}\&ct_name2print=$ctt->{ct_name}\&c_id4trans=$ctt->{c_id}\&u_id=$users_dms->{u_id}\&pkey=$apikeyconf{pdfprinter}->{pkey} $varenv->{pdf}/$praefix-$ctt->{ct_name}.pdf\nreturn: $print_return\nfilesize: $filesize\nexit_code: $feedb->{exit_code}\n\n" ;
if ( $ R:: print_pdfview ) {
if ( - f "$varenv->{basedir}/pdf/$praefix-$ctt->{ct_name}.pdf" ) {
print "<script type=\"text/javascript\">window.open('$varenv->{wwwhost}/FileOut?file=$praefix-$ctt->{ct_name}.pdf');</script>" ;
} else {
$ feedb - > { message } = "failure::PDF konnte nicht generiert werden, bitte Info an: admin\@sharee.bike\n $varenv->{wwwhost}/pdf/$praefix-$ctt->{ct_name}.pdf" ;
}
}
}
close EMA ;
return $ feedb ;
} #end print_pdf
#send_invoice_cms for variable ticket-mailing
sub send_invoice_cms {
my $ self = shift ;
my $ q = shift ;
my $ varenv = shift ;
my $ node_meta = shift ;
my $ users_dms = shift ;
my $ feedb = shift ;
$ q - > import_names ( 'R' ) ;
my $ dbh = "" ;
my $ pref_ctt = {
table = > "contenttrans" ,
fetch = > "one" ,
c_id = > $ R:: c_id4trans ,
} ;
my $ ctt = { c_id = > 0 } ;
$ ctt = $ dbt - > fetch_record ( $ dbh , $ pref_ctt ) if ( $ R:: c_id4trans ) ;
if ( $ ctt - > { c_id } ) {
my $ praefix = "$ctt->{txt00}-$varenv->{praefix}" ;
my $ lang_ctt = $ ctt - > { txt11 } || "de" ;
$ varenv - > { cms } = $ dbt - > fetch_cms ( $ dbh , { lang = > $ lang_ctt } ) ;
my $ sum_paid = $ R:: sum_paid || 0 ;
$ sum_paid =~ s/,/\./ ;
#print pdf
if ( $ R:: print_pdf ) {
$ feedb = $ self - > print_pdf ( $ q , $ varenv , $ node_meta , $ users_dms , $ feedb ) ;
}
my $ cms_message_key = $ R:: cms_message_key ;
if ( ! $ varenv - > { cms } - > { $ cms_message_key } - > { txt } ) {
$ feedb - > { message } = "failure::Achtung, CMS-Text '$cms_message_key' ist nicht vorhanden. Es wurde keine eMail versandt!" ;
} if ( $ sum_paid != $ ctt - > { int01 } ) {
$ feedb - > { message } = "failure::Achtung, die Summe der Positionen $sum_paid enstpricht nicht der Rechnung-Summe $ctt->{int01}. Die Rechnung muss vor dem eMail versand erst gebucht werden!" ;
} else {
my $ with_pdf = "" ;
$ with_pdf = 1 if ( - f "$varenv->{basedir}/pdfinvoice/$praefix-$ctt->{ct_name}.pdf" && $ R:: print_pdf ) ;
system ( "$dbt->{copri_conf}->{basedir}/$varenv->{syshost}/src/scripts/mailTransportcms.pl '$varenv->{syshost}' 'send_invoice_cms' '$ctt->{int10}' '$ctt->{c_id}' '' '$cms_message_key' '$with_pdf'" ) ;
}
}
return $ feedb ;
} #end send_invoice_cms
#Tagesabschluss
sub close_transactions {
my $ self = shift ;
my $ q = shift ;
my $ varenv = shift ;
my $ node_meta = shift ;
my $ users_dms = shift ;
$ q - > import_names ( 'R' ) ;
my $ dbh = "" ;
my $ feedb = {
u_rows = > 0 ,
message = > "" ,
} ;
#could be Kunden-Faktura 100002
my $ adr_close = {
c_id = > 3 ,
txt01 = > '' ,
txt02 = > '' ,
txt03 = > '' ,
txt06 = > '' ,
txt07 = > '' ,
txt08 = > '' ,
txt10 = > '' ,
txt11 = > '' ,
} ;
my $ now_dt = strftime "%Y-%m-%d %H:%M:%S" , localtime ;
open ( EMA , ">> $varenv->{logdir}/close_transactions.log" ) ;
print EMA "\n*** $now_dt close_transactions\n" . Dumper ( $ q ) . "\n" ;
my $ journal_id = "300011" ;
my $ journal_tpl = "209" ;
my $ ct_id = $ dbt - > insert_contenttrans ( $ dbh , $ adr_close , $ journal_id , $ journal_tpl , "" , $ users_dms - > { u_id } ) ;
my $ pref = {
table = > "contenttrans" ,
fetch = > "one" ,
main_id = > $ journal_id ,
template_id = > $ journal_tpl ,
c_id = > $ ct_id ,
} ;
my $ ctt = { c_id = > 0 } ;
$ ctt = $ dbt - > fetch_record ( $ dbh , $ pref ) if ( $ pref - > { c_id } ) ;
if ( $ ctt - > { c_id } ) {
my $ pref_close = {
table = > "contenttrans" ,
close_id = > $ ctt - > { c_id } ,
main_id = > $ journal_id ,
template_id = > $ journal_tpl ,
source_main_id = > '300008,300009,300011' , #Rechnung,Storno,Verkaufsjournal
source_template_id = > 218 ,
} ;
$ feedb - > { u_rows } += $ dbt - > update_close_transactions ( $ dbh , $ pref_close ) ;
}
close EMA ;
return $ feedb ;
} #end close_transactions
#SEPA request "managemandate"
2021-12-30 12:05:56 +01:00
sub managemandate_main {
my $ self = shift ;
my $ varenv = shift ;
my $ ctadr = shift ;
my $ ctt = shift || "" ;
my $ owner = shift || 0 ;
my $ payoneret = "" ;
2022-11-22 18:10:06 +01:00
my $ payone_conf = $ dbt - > { payone_conf } || { } ;
2021-12-30 12:05:56 +01:00
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 ;
2023-11-16 20:11:13 +01:00
} #end SEPA request "managemandate"
2021-12-30 12:05:56 +01:00
#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 } ) ;
2024-01-16 06:23:43 +01:00
if ( $ ctt - > { c_id } && ( ! $ ctt - > { int04 } || $ ctt - > { int14 } || $ ctt_rec - > { payone_reset } ) ) {
2022-02-22 18:31:25 +01:00
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
2024-01-16 06:23:43 +01:00
if ( $ ctt - > { c_id } && ( ! $ ctt - > { int04 } || $ ctt - > { int14 } || $ ctt_rec - > { payone_reset } ) ) {
2022-02-22 18:31:25 +01:00
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
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 = "" ;
2023-11-16 20:11:13 +01:00
my $ ua = LWP::UserAgent - > new (
ssl_opts = > {
SSL_version = > 'TLSv12:!SSLv2:!SSLv3:!TLSv1:!TLSv11' ,
}
) ;
$ ua - > agent ( "sharee payone POST API" ) ;
2021-12-30 12:05:56 +01:00
#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 ) ;
2023-04-11 17:57:31 +02:00
print FILE "\n*** $now_dt (ctadr_id:$ctadr->{c_id}, ctt_id:$ctt->{c_id}) from Payment.pm\n$httpReqServer \n" if ( $ debug ) ;
2021-12-30 12:05:56 +01:00
print FILE "---> request to payone $todo:\n$post\n" ;
#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" ) ;
2022-12-16 08:37:05 +01:00
#$update_adr->{txt28} = $val if($key eq "mandate_text" && ($val =~ /SEPA/ || !$val));
$ update_adr - > { txt28 } = $ now_dt . " $todo\n" . $ q - > escapeHTML ( $ res - > content ) ;
2021-12-30 12:05:56 +01:00
}
2023-03-17 13:23:04 +01:00
$ update_adr - > { int12 } = 0 if ( $ vde_on_fail != 2 ) ; #Vde
2021-12-30 12:05:56 +01:00
$ 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
}
2023-03-17 13:23:04 +01:00
print FILE "managemandate update_adr:" . Dumper ( $ update_adr ) . "\n" if ( $ debug ) ;
2021-12-30 12:05:56 +01:00
}
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_adr - > { int12 } = 0 ;
$ update_adr - > { int17 } = $ useridval if ( $ useridval ) ;
} elsif ( $ ctadr - > { c_id } ) {
$ update_ctt - > { int14 } = 1 ; #OPOS
$ update_adr - > { int12 } = $ vde_on_fail ; #Vde
}
2022-12-16 08:37:05 +01:00
#2022-12-15 save log for any
$ update_ctt - > { txt28 } = $ now_dt . " $todo\n" . $ res - > content . "\n" . $ update_ctt - > { txt28 } ;
2021-12-30 12:05:56 +01:00
}
#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_adr - > { int12 } = 0 ;
} else { #because of Prelogic logic set it empty if no capture
$ update_ctt - > { int14 } = 1 ; #OPOS
$ update_adr - > { int12 } = $ vde_on_fail ; #Vde
2023-05-05 07:30:00 +02:00
#TOD send_capture_fail mail?
2021-12-30 12:05:56 +01:00
}
2022-12-16 08:37:05 +01:00
$ update_ctt - > { txt28 } = $ now_dt . " $todo\n" . $ res - > content . "\n" . $ update_ctt - > { txt28 } ;
2021-12-30 12:05:56 +01:00
}
} 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 ) ;
2024-01-16 06:23:43 +01:00
$ update_ctt - > { int14 } = 1 if ( $ ctt - > { int04 } ) ; #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/ ) {
if ( $ payoneLive == 1 && $ ctadr - > { c_id } ) {
2022-12-16 08:37:05 +01:00
$ update_ctt - > { txt28 } = $ now_dt . " $todo\n" . $ res - > content . "\nVde.\n" . $ update_ctt - > { txt28 } ;
$ update_adr - > { txt28 } = $ now_dt . " $todo\n" . $ res - > content . "\nVde.\n" . $ update_adr - > { txt28 } ;
2021-12-30 12:05:56 +01:00
#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
}
}
} else {
if ( $ payoneLive == 1 && $ ctt - > { c_id } ) {
2022-12-16 08:37:05 +01:00
$ update_ctt - > { txt28 } = $ now_dt . " $todo\n" . $ res - > content . "\n" . $ update_ctt - > { txt28 } ;
$ update_adr - > { txt28 } = $ now_dt . " $todo\n" . $ res - > content . "\n" . $ update_adr - > { txt28 } ;
2021-12-30 12:05:56 +01:00
}
}
}
} 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
2023-11-16 20:11:13 +01:00
#set contentadr owner and mtime only if vde or payone-return will be set by payone id's
2022-02-23 12:33:59 +01:00
if ( ( ( $ update_adr - > { int12 } && $ update_adr - > { int12 } > 0 ) || $ update_adr - > { txt28 } ) && ( $ owner == 178 || $ owner == 179 ) ) {
$ update_adr - > { owner } = "$owner" ;
$ update_adr - > { mtime } = "now()" ;
}
2023-04-11 17:57:31 +02:00
if ( $ ctadr - > { c_id } > 0 ) {
$ dbt - > update_record ( $ dbh , $ update_adr , $ ctadr ) ;
2023-12-19 05:13:56 +01:00
print FILE Dumper ( $ update_adr ) . "\n" if ( $ debug ) ;
2023-04-11 17:57:31 +02:00
#2023-04-11 set it global by update adr also on primary
#disabled, because isuser_rentable will be only used by operator rental
2024-01-09 07:27:19 +01:00
#2024-01-08 enabled again, also done in APIpayone after payone feedback
my $ dbh_primary = $ dbt - > dbconnect_extern ( $ dbt - > { primary } - > { sharee_primary } - > { database } - > { dbname } ) ;
$ dbt - > update_record ( $ dbh_primary , $ update_adr , $ ctadr ) ;
2023-04-11 17:57:31 +02:00
}
2021-12-30 12:05:56 +01:00
$ dbt - > update_record ( $ dbh , $ update_ctt , $ ctt ) if ( $ ctt - > { c_id } > 0 ) ;
2023-12-19 05:13:56 +01:00
close ( FILE ) if ( $ debug ) ;
2021-12-30 12:05:56 +01:00
return $ payoneret ;
2024-01-09 07:27:19 +01:00
} #end rpc
2021-12-30 12:05:56 +01:00
#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" ,
} ;
2023-12-01 20:14:31 +01:00
my $ ctadr = { c_id = > 0 } ;
$ ctadr = $ dbt - > fetch_record ( $ dbh , $ authref ) if ( $ c_id ) ;
2021-12-30 12:05:56 +01:00
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" ;
2023-11-16 20:11:13 +01:00
} #end SEPA PDFGenerator
2021-12-30 12:05:56 +01:00
#jused by payone_cron.pl
2023-11-16 20:11:13 +01:00
sub payone_capture {
2021-12-30 12:05:56 +01:00
my $ self = shift ;
my $ varenv = shift ;
my $ ctf = shift ;
my $ ctadr = shift ;
my $ ctt = shift ;
my $ sum_paid = shift ;
my $ owner = shift ;
my $ mandant_id = 100002 ;
2022-02-14 16:06:02 +01:00
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 ;
2024-01-16 06:23:43 +01:00
my $ now_dt = strftime "%Y-%m-%d %H:%M:%S" , localtime ;
my $ update_adr = {
table = > "contentadr" ,
mtime = > "now()" ,
owner = > $ owner ,
} ;
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 ,
2024-01-16 06:23:43 +01:00
int04 = > 0 ,
2022-07-13 11:19:55 +02:00
int14 = > 2 ,
} ;
2022-10-14 08:28:51 +02:00
my $ node_faktura = $ dbt - > get_node ( $ dbh , $ dbt - > { shareedms_conf } - > { faktura } ) ;
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 ;
}
2024-01-16 06:23:43 +01:00
#set also state because we still need (payone) for some text selection TODO
2023-12-19 05:13:56 +01:00
my $ state = $ ctt - > { state } || "" ;
my $ p_hash = $ dbt - > { shareedms_conf } - > { payment_state2 } ;
2024-01-16 06:23:43 +01:00
if ( $ ctadr - > { ct_name } =~ /^\w{2}-\d+/ ) {
$ state = $ p_hash - > { 1 } ;
$ update_ctt - > { int04 } = 1 ;
}
if ( length ( $ ctadr - > { ct_name } ) >= 19 ) {
$ state = $ p_hash - > { 2 } ;
$ update_ctt - > { int04 } = 2 ;
}
if ( $ ctadr - > { ct_name } =~ /Prepaid-\d+/ ) {
$ state = $ p_hash - > { 3 } ;
$ update_ctt - > { int04 } = 3 ;
}
2022-07-13 11:19:55 +02:00
$ update_ctt - > { state } = "$state" ;
2024-01-16 06:23:43 +01:00
$ dbt - > update_record ( $ dbh , $ update_ctt , $ ctt ) if ( $ update_ctt - > { int04 } ) ;
2022-02-22 08:31:35 +01:00
2021-12-30 12:05:56 +01:00
#in cron we set OPOS anyway. If payone captured, it will be set int14=null
2024-01-16 06:23:43 +01:00
if ( ! $ update_ctt - > { int04 } ) {
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
2024-01-16 06:23:43 +01:00
if ( $ 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-12-19 19:00:27 +01:00
} elsif ( $ 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
2024-01-16 06:23:43 +01:00
if ( $ ctadr - > { ct_name } =~ /^\w{2}-\d+/ && $ ctt - > { txt16 } && $ ctt - > { int04 } == 1 ) {
2021-12-30 12:05:56 +01:00
$ self - > captureSEPA_main ( $ varenv , $ ctadr , $ ctt , $ owner ) ;
}
#CC capture
2024-01-16 06:23:43 +01:00
elsif ( length ( $ ctadr - > { ct_name } ) >= 19 && $ ctt - > { txt16 } && $ ctt - > { int04 } == 2 ) {
2021-12-30 12:05:56 +01:00
$ self - > captureCC_main ( $ varenv , $ ctadr , $ ctt , $ owner ) ;
}
2024-01-16 06:23:43 +01:00
#Prepaid
elsif ( $ ctadr - > { ct_name } =~ /Prepaid-\d+/ && $ ctt - > { int04 } == 3 ) {
#APIshareeio APIcall
my $ shareeio_json = {
request = > "capture_prepaid" ,
userID = > "$ctadr->{c_id}" ,
sum_paid = > "$update_ctt->{int01}" ,
invoice_reference = > "$dbt->{operator}->{$varenv->{dbname}}->{oprefix}-$ctt->{c_id}-$ctt->{ct_name}" ,
} ;
my $ vde_on_fail = $ ctadr - > { int12 } || 1 ; #keep last or set 1
my $ response_in = { } ;
$ response_in = $ rpcs - > request_shareeio ( $ varenv , $ dbh , $ ctadr , $ shareeio_json ) ;
if ( $ response_in - > { shareeio } - > { response_state } =~ /Success/i ) {
$ update_ctt - > { int14 } = "null" ;
$ update_ctt - > { pay_time } = "now()" ;
$ update_adr - > { int12 } = "null" ;
} else {
$ update_adr - > { int12 } = $ vde_on_fail ; #Vde
}
$ update_ctt - > { txt28 } = $ now_dt . " $state\n" . $ response_in - > { shareeio } - > { response_state } . "\n\n" . $ ctt - > { txt28 } ;
$ dbt - > update_record ( $ dbh , $ update_ctt , $ ctt ) ;
$ dbt - > update_record ( $ dbh , $ update_adr , $ ctadr ) ;
my $ dbh_primary = $ dbt - > dbconnect_extern ( $ dbt - > { primary } - > { sharee_primary } - > { database } - > { dbname } ) ;
$ dbt - > update_record ( $ dbh_primary , $ update_adr , $ ctadr ) ;
}
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 = "" ;
2023-01-25 07:25:12 +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-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
2023-06-01 07:50:17 +02:00
if ( - f "$dbt->{copri_conf}->{basedir}/$varenv->{syshost}/pdfinvoice/$praefix-$ctt->{ct_name}.pdf" && ! $ ctt - > { txt30 } ) {
2023-08-02 19:03:27 +02:00
system ( "$dbt->{copri_conf}->{basedir}/$varenv->{syshost}/src/scripts/mailTransportcms.pl '$varenv->{syshost}' 'send_invoice' '$ctt->{int10}' '$ctt->{c_id}' '' 'email-invoice' '1'" ) ;
print EMA "---> Payment send_invoice $praefix-$ctt->{ct_name}.pdf email command: $dbt->{copri_conf}->{basedir}/$varenv->{syshost}/src/scripts/mailTransportcms.pl '$varenv->{syshost}' 'send_invoice' '$ctt->{int10}' '$ctt->{c_id}' '' 'email-invoice' '1'\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 ) ;
}
2024-01-09 07:27:19 +01:00
#request "payone-link"
2023-12-19 05:13:56 +01:00
sub generate_payonelink {
my $ self = shift ;
my $ varenv = shift ;
my $ ctadr = shift ;
my $ prepaidhash = shift || { } ;
my $ prepaid_amount = shift || 0 ;
2024-01-11 06:40:31 +01:00
my $ aowner = shift || 0 ;
my $ app_name = $ dbt - > { merchant_ids } - > { $ varenv - > { merchant_id } } - > { app_name } if ( $ varenv - > { merchant_id } && $ dbt - > { merchant_ids } - > { $ varenv - > { merchant_id } } - > { app_name } ) ;
2023-12-19 05:13:56 +01:00
my $ ret_json = { } ;
my $ response_in = { } ;
2024-01-09 07:27:19 +01:00
my $ feedb = { message = > "" } ;
2023-12-19 05:13:56 +01:00
my $ dbh = "" ;
my $ now_dt = strftime "%Y-%m-%d %H:%M:%S" , localtime ;
open ( FILE , ">>$varenv->{logdir}/payonelink.log" ) ;
print FILE "\n*** $now_dt 'generate_payonelink' ctadr:$ctadr->{c_id}|$ctadr->{txt08}\n" ;
2024-01-09 07:27:19 +01:00
$ prepaid_amount =~ s/,/\./ ;
2023-12-19 05:13:56 +01:00
my $ prepaid_amount2 = 0 ;
2024-01-09 07:27:19 +01:00
$ prepaid_amount2 = $ 1 if ( $ prepaid_amount =~ /(\d+\.\d{2})/ || $ prepaid_amount =~ /(\d+)/ ) ;
2023-12-19 05:13:56 +01:00
if ( $ ctadr - > { c_id } && $ prepaidhash - > { prepaid_id } && $ prepaid_amount2 >= 5 ) {
my $ lastname = $ ctadr - > { txt01 } ;
( my $ firstname , $ lastname ) = split ( /\s+/ , $ ctadr - > { txt01 } ) if ( $ ctadr - > { txt01 } =~ /\w\s+\w/i ) ;
chomp ( $ firstname ) ;
chomp ( $ lastname ) ;
2024-01-09 07:27:19 +01:00
my $ firstName = Encode:: encode ( 'utf-8' , Encode:: decode ( 'iso-8859-1' , $ firstname ) ) ;
my $ lastName = Encode:: encode ( 'utf-8' , Encode:: decode ( 'iso-8859-1' , $ lastname ) ) ;
my $ email = Encode:: encode ( 'utf-8' , Encode:: decode ( 'iso-8859-1' , $ ctadr - > { txt08 } ) ) ;
2023-12-19 05:13:56 +01:00
my $ currency = "EUR" ;
my $ amount = 0 ;
$ amount = $ prepaid_amount2 * 100 if ( $ prepaid_amount2 ) ;
2024-01-09 07:27:19 +01:00
my $ reference = Encode:: encode ( 'utf-8' , Encode:: decode ( 'iso-8859-1' , $ prepaidhash - > { prepaid_id } ) ) ;
#my $epoche = time();
#$reference = "1_$epoche";#For tests generate always new reference!
my $ description = Encode:: encode ( 'utf-8' , Encode:: decode ( 'iso-8859-1' , $ prepaidhash - > { description } ) ) ;
my $ pay_json = {
currency = > "$currency" ,
2023-12-19 05:13:56 +01:00
intent = > 'authorization' ,
2024-01-09 07:27:19 +01:00
merchantId = > "$dbt->{payonelink_conf}->{merchantId}" ,
accountId = > "$dbt->{payonelink_conf}->{accountId}" ,
portalId = > "$dbt->{payonelink_conf}->{portalId}" ,
mode = > "$dbt->{payonelink_conf}->{mode}" ,
notifyUrl = > "$dbt->{payonelink_conf}->{notifyUrl}" ,
description = > "Ihr vorbereiteter sharee.bike Prepaid/Vorkasse Auftrag" ,
2024-01-11 06:40:31 +01:00
paymentMethods = > [ 'visa' , 'mastercard' , 'giropay' ] ,
2024-01-09 07:27:19 +01:00
reference = > "$reference" ,
2023-12-19 05:13:56 +01:00
shoppingCart = > [ {
2024-01-09 07:27:19 +01:00
type = > "goods" ,
2023-12-19 05:13:56 +01:00
number = > "$prepaidhash->{number}" ,
2024-01-09 07:27:19 +01:00
description = > "$description" ,
2023-12-19 05:13:56 +01:00
price = > $ amount ,
quantity = > 1 ,
vatRate = > 19
2024-01-09 07:27:19 +01:00
} ] ,
"billing" = > {
firstName = > "$firstName" ,
lastName = > "$lastName" ,
email = > "$email" ,
country = > "DE"
}
2023-12-19 05:13:56 +01:00
} ;
2024-01-11 06:40:31 +01:00
#we still have sepa. do it without sepa because of workflow
2024-01-09 07:27:19 +01:00
#paymentMethods => ['visa', 'mastercard', 'paypal', 'sofort', 'paydirekt', 'giropay', 'sepa'],
2023-12-19 05:13:56 +01:00
2024-01-09 07:27:19 +01:00
my $ datahash = "$pay_json->{merchantId}$pay_json->{accountId}$pay_json->{portalId}$pay_json->{mode}$pay_json->{reference}$amount$currency" ;
2023-12-19 05:13:56 +01:00
2024-01-09 07:27:19 +01:00
my $ paytoken = hmac_sha256_base64 ( $ datahash , $ dbt - > { payonelink_conf } - > { portalKey } ) ;
# Fix padding of Base64 digests
while ( length ( $ paytoken ) % 4 ) {
$ paytoken . = '=' ;
}
print FILE "datahash: $datahash, $dbt->{payonelink_conf}->{portalKey}\n" ;
print FILE "paytoken: $paytoken\n" ;
2023-12-19 05:13:56 +01:00
2024-01-09 07:27:19 +01:00
my $ rest_json = encode_json ( \ % { $ pay_json } ) ;
2023-12-19 05:13:56 +01:00
print FILE "rest_json:\n" . Dumper ( $ rest_json ) . "\n" ;
2024-01-09 07:27:19 +01:00
( $ ret_json , my $ ret_status ) = $ self - > rpcpayone_postjson ( "$paytoken" , "$rest_json" ) ;
my $ update_pos = {
table = > "contenttranspos" ,
ca_id = > "$ctadr->{c_id}" ,
mtime = > "now()" ,
2024-01-11 06:40:31 +01:00
owner = > "$aowner" ,
2024-01-09 07:27:19 +01:00
} ;
2023-12-19 05:13:56 +01:00
eval {
$ response_in = decode_json ( $ ret_json ) ;
print FILE "<--- payonelink response_in with status_line: $ret_status\n" . Dumper ( $ response_in ) ;
2024-01-09 07:27:19 +01:00
print FILE $ response_in - > { link } . "\n" ;
$ update_pos - > { txt30 } = $ response_in - > { link } ;
2023-12-19 05:13:56 +01:00
print FILE $ ret_json . "\n" ;
} ;
if ( $@ ) {
print FILE "<--- failure payonelink raw response_in with status_line: $ret_status\n" . Dumper ( $ ret_json ) . "\n" ;
print FILE "warn:" . $@ . "\n" ;
}
2024-01-09 07:27:19 +01:00
$ update_pos - > { txt25 } = "$prepaidhash->{response_log}\n- $ret_status" ;
my $ ctpos = { c_id = > $ prepaidhash - > { number } } ;
my $ rows = $ dbt - > update_record ( $ dbh , $ update_pos , $ ctpos ) if ( $ ctpos - > { c_id } ) ;
my $ cms_message_key = "email-payonelink" ;
if ( ! $ varenv - > { cms } - > { $ cms_message_key } - > { txt } ) {
$ feedb - > { message } = "failure::Achtung, '$cms_message_key' ist nicht vorhanden. Es wurde keine eMail versandt!" ;
} elsif ( $ ctpos - > { c_id } ) {
2024-01-11 06:40:31 +01:00
system ( "$dbt->{copri_conf}->{basedir}/$varenv->{syshost}/src/scripts/mailTransportcms.pl '$varenv->{syshost}' 'send_payonelink' '$ctadr->{c_id}' '$ctpos->{c_id}' '' '$cms_message_key' '' '$app_name'" ) ;
2024-01-09 07:27:19 +01:00
}
} #end if($ctadr->{c_id} && $prepaidhash->{prepaid_id} && $prepaid_amount2 >= 5)
else {
2023-12-19 05:13:56 +01:00
$ ret_json = "failure:: $ctadr->{c_id} && $prepaidhash->{prepaid_id} && $prepaid_amount2 >= 5" ;
}
close FILE ;
return $ ret_json ;
2024-01-09 07:27:19 +01:00
} #end generate_payonelink
2023-12-19 05:13:56 +01:00
2024-01-09 07:27:19 +01:00
#request JSON POST to onelink
sub rpcpayone_postjson {
2023-12-19 05:13:56 +01:00
my $ self = shift ;
my $ paytoken = shift ;
my $ rest_json = shift || "" ;
my $ ua = LWP::UserAgent - > new (
ssl_opts = > {
SSL_version = > 'TLSv12:!SSLv2:!SSLv3:!TLSv1:!TLSv11' ,
}
) ;
2024-01-09 07:27:19 +01:00
$ ua - > agent ( "sharee payonelink POST API" ) ;
2023-12-19 05:13:56 +01:00
my $ bytes = 100000 ;
$ ua - > max_size ( $ bytes ) ;
$ ua - > default_header ( 'Authorization' = > "payone-hmac-sha256 $paytoken" ) ;
2024-01-09 07:27:19 +01:00
#print Dumper($ua);
2023-12-19 05:13:56 +01:00
2024-01-09 07:27:19 +01:00
#local tests
#my $endpoint = "https://shareeapp-fr01.copri-bike.de/APIvelo";
my $ endpoint = "https://onelink.pay1.de/api/v1/payment-links/" ;
2023-12-19 05:13:56 +01:00
my $ req = HTTP::Request - > new ( POST = > "$endpoint" ) ;
$ req - > content_type ( 'application/json' ) ;
$ req - > content ( $ rest_json ) ;
my $ res = $ ua - > request ( $ req ) ;
if ( $ res - > is_success ) {
#print $res->content;
#print $res->status_line, "\n";
return ( $ res - > content , $ res - > status_line ) ;
} else {
#print $res->status_line, "\n";
return ( "" , $ res - > status_line ) ;
}
}
2021-12-30 12:05:56 +01:00
1 ;