sharee.bike/copri4/main/src/Mod/Shareework.pm

1129 lines
40 KiB
Perl
Executable file

package Shareework;
#
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
#this module holds sharee app user-account management methods.
#some methods are also used by DMS Basedit
#
#disable for syntax check
#use lib qw(/var/www/copri-bike/shareeapp-primary/src);
#
use strict;
use warnings;
use POSIX;
use CGI; # only for debugging
use Mod::Libenz;
use Mod::DBtank;
use Mod::Buttons;
use Lib::Config;
use Mod::APIfunc;
use Digest::MD5 qw(md5 md5_hex);
use Digest::SHA qw(sha1_base64 sha256_base64);
use Scalar::Util qw(looks_like_number);
use URI::Encode;
use Mod::Basework;
use Mod::Payment;
#use Mod::MailTransport;
use Mod::SMSTransport;
use Data::Dumper;
my $cf = new Config;
my $but = new Buttons;
my $lb = new Libenz;
my $dbt = new DBtank;
my $apif = new APIfunc;
my $bw = new Basework;
my $payone = new Payment;
#my $mailtrans = new MailTransport;
my $smstrans = new SMSTransport;
my $q = new CGI;
my $uri_encode = URI::Encode->new( { encode_reserved => 1 } );
sub new {
my $class = shift;
my $self = {};
bless($self,$class);
return $self;
}
my $i_rows=0;
my $u_rows=0;
my $d_rows=0;
#
#also done in src/Tpl/Anmelden.pm!?
sub delete_account {
my $self = shift;
my $c_id = shift;
my $owner = shift;
my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime;
my %varenv = $cf->envonline();
my $debug=1;
my $dbh = "";
$bw->log("delete_account",$c_id,"");
open(FILE,">>$varenv{logdir}/delete_account.log") if($debug);
my $dbh_primary = $dbt->dbconnect_extern($dbt->{primary}->{sharee_primary}->{database}->{dbname});
my $authref = {
table => "contentadr",
fetch => "one",
template_id => "202",
c_id => "$c_id",
};
my $ctadr = $dbt->fetch_record($dbh_primary,$authref);
print FILE "\n*-->DB $varenv{dbname} $now_dt| owner: $owner | c_id: $c_id \n" if($debug);
#First on operator DMS delete and then second on primary delete txt17 operator DB
if($varenv{dbname} ne $dbt->{primary}->{sharee_primary}->{database}->{dbname}){
$d_rows += $dbt->delete_content($dbh,"contentadr",$c_id);
my $update_primary = {
table => "contentadr",
mtime => "now()",
owner => "$owner",
c_id => "$c_id",
};
my @operators = ("$ctadr->{txt17}");
@operators = split(/\s+/,$ctadr->{txt17}) if($ctadr->{txt17} =~ /\w\s\w/);
my @new_operators = ();
foreach(@operators){
push(@new_operators,$_) if($_ =~ /sharee_\w+/ && $_ !~ /$varenv{dbname}/);
}
print FILE "delete operator dbname: $varenv{dbname} | update_primary txt17='@new_operators'\n";
$u_rows = $dbt->update_one($dbh_primary,$update_primary,"txt17='@new_operators'");
$u_rows = $dbt->update_one($dbh_primary,$update_primary,"txt19=null");
}else{
print FILE "delete on all by operatorsloop by primary\n";
$dbt->update_operatorsloop($varenv{dbname},$ctadr->{c_id},"delete");
$d_rows += $dbt->delete_content($dbh,"contentadr",$c_id);
}
close(FILE) if($debug);
return "$i_rows-$u_rows-$d_rows";
}
#create_account is alwas done on primary first
sub create_account(){
my $self = shift;
my $dbh = shift || "";
my $owner = shift;
my $insert_adr = {
table => "contentadr",
template_id => 202,
main_id => 200011,
mtime => 'now()',
owner => $owner,
int20 => $owner,
};
my $c_idnew = $dbt->insert_contentoid($dbh,$insert_adr,"");
my $ctadr = { c_id => $c_idnew };
$insert_adr->{ct_name} = $c_idnew;
$insert_adr->{barcode} = $c_idnew;
$dbt->update_record($dbh,$insert_adr,$ctadr);
return $c_idnew;
}
#sharee save_account is always done on primary first
sub save_account(){
my $self = shift;
my $dbh = shift || "";
my $q = shift;
my $c_id = shift;
my $varmerch = shift || "";
my $owner = shift || 0;
my $table = "contentadr";
$q->import_names('R');
my @keywords = $q->param;
my $debug=1;
my $feedb = {
u_rows => 0,
prepaid_id => 0,
message => "",
};
my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime;
my %varenv = $cf->envonline();
$bw->log("save_account by merchant_id $varmerch->{merchant_id}, project_id $varmerch->{project_id} on dbname $varenv{dbname}",$q,"");
open(FILE,">>$varenv{logdir}/save_account.log") if($debug);
#Always on sharee_primary
if($varenv{dbname} ne $dbt->{primary}->{sharee_primary}->{database}->{dbname}){
$dbh = $dbt->dbconnect_extern($dbt->{primary}->{sharee_primary}->{database}->{dbname});
print FILE "\n*-->If no-primary connect DB $dbt->{primary}->{sharee_primary}->{database}->{dbname} (mvar: $varmerch->{merchant_id}|$varmerch->{dbname}|$varenv{dbname}) $now_dt| c_id: $c_id| owner: $owner\n" if($debug);
}else{
#keep in mind, should be only done by web-app user Formular (primary)
print FILE "\n*-->Else take local copri-Instance DB $varenv{dbname} (mvar: $varmerch->{merchant_id}|$varmerch->{dbname}) $now_dt| c_id: $c_id| owner: $owner\n" if($debug);
}
my $authref = {
table => "contentadr",
fetch => "one",
template_id => "202",
c_id => "$c_id",
};
my $ctadr = { c_id => 0 };
$ctadr = $dbt->fetch_record($dbh,$authref) if($c_id > 0);
my $update_adr = {
table => "contentadr",
mtime => "now()",
owner => "$owner",
c_id => "$c_id",
};
my $ret = "";
my $ret_conflict = "";
my $fkeys = "";
my $pw_dummy = "";
@keywords = grep {!/txt31/} @keywords;
#print FILE Dumper($q) if($debug);
foreach(@keywords){
$fkeys .= "$_,";
my $val = $q->param("$_");
my $valxx = $q->escapeHTML("$val");
$valxx =~ s/^\s+//;
$valxx =~ s/\s+$//;
if($debug){
if($_ !~ /txt04/){
print FILE "$_:$valxx \n";
}else{
print FILE "$_:is not logged\n";
}
}
if($_ =~ /^int|barcode/){
$valxx =~ s/,/./g;
if(looks_like_number($valxx)){
$valxx = $valxx;
}else{
$valxx = "null"
}
}
if($_ =~ /^txt\d+|^int\d+|ct_name/){
#PW
if($_ =~ /^txt04/){
if($valxx eq "xxxxxxxx"){
$pw_dummy = "1";
}elsif(length($valxx) >= 8){
my $pwmd5 = md5_hex($valxx) || "";
my $pwsha256=sha256_base64($pwmd5) || "";
$update_adr->{txt04} = "$pwsha256" if(length($pwsha256) > 20);
$update_adr->{int06} = "null";#pw renewd
}
}
#operators, only if saved by operator DMS
elsif($_ eq "txt17"){
my %txt17 = ();
if($ctadr->{txt17} =~ /\w\s\w/){
%txt17 = map { $_ => 1 } split(/\s+/,$ctadr->{txt17});
}else{
$txt17{$ctadr->{txt17}} = 1;
}
my $txt19 = $q->escapeHTML($q->param('txt19')) || "";
if($txt19 && $dbt->{operator}{$txt19}->{database}->{dbname}){
$txt17{$dbt->{operator}{$txt19}->{database}->{dbname}} = 1;
}
my @operators = ();
foreach my $keys (keys %txt17) {
push(@operators,$keys);
}
$update_adr->{txt17} = "@operators";
}
#Rabatt|payone cron-intervall|Ilockit-Admin|miniq
elsif($_ =~ /int07|int16|int19|int23/){
$update_adr->{$_} = $valxx;
}
#Text Sonstiges
elsif($_ =~ /txt29/){
$update_adr->{$_} = "$valxx";
}
#txt15=Bonus- oder Freischalcode (falls vorhanden)=15
#only check bonusnr and add operators dbname.
#bonustarif will be set after operator insert
elsif($_ eq "txt15"){
print FILE "Bonusnr request $_: $valxx\n" if($debug);
#--> Only done by App web iframe Anmelde-Registration formular
if($varenv{dbname} eq $dbt->{primary}->{sharee_primary}->{database}->{dbname}){
my %txt17 = ();
if($ctadr->{txt17} =~ /\w\s\w/){
%txt17 = map { $_ => 1 } split(/\s+/,$ctadr->{txt17});
}else{
$txt17{$ctadr->{txt17}} = 1;
}
#accept KN codes without prefix
if($valxx && $varmerch->{project_id} && $varmerch->{project_id} eq "Konstanz"){
my $valappend = $valxx;
$valxx = "KN-$valappend";
print FILE "Prepare KN Bonusnr by prefix $valxx" . "\n" if($debug);
}
#accept BVB codes also without prefix
elsif($valxx && $valxx !~ /-/ && $varmerch->{project_id} && $varmerch->{project_id} eq "Freiburg"){
my $operator_conf = "";
$operator_conf = $dbt->get_operator_conf("BVB");
if(ref($operator_conf) eq "HASH" && ref($operator_conf->{subproject}) eq "HASH" && $R::txt06 =~ /$varmerch->{project_id}/i){
my $valappend = $valxx;
foreach my $sub (keys %{ $operator_conf->{subproject} }){
if($operator_conf->{subproject}->{$sub} && $R::txt03 =~ /$operator_conf->{subproject}->{$sub}/i){
$valxx = "BVB-$sub-$valappend";
}
}
print FILE "Prepare BVB Bonusnr by prefix $valxx" . "\n" if($debug);
}
}
#Freischaltcode format can be "CA-Li-hsze789k" or "CA1234567"
if($valxx && ($valxx =~ /^(\w{2,3})-([\w\-]+)/i || $valxx =~ /^(\w{2,3})(\d+)/i)){
$valxx =~ s/\s//g;
my $bonus_prefix = uc($1),
my $bonusnr = $2;
my $operator_conf = $dbt->get_operator_conf($bonus_prefix);
my @txt30_op = ();
if(ref($operator_conf) eq "HASH" && $operator_conf->{oprefix} && $operator_conf->{database}->{dbname}){
print FILE "Bonus- oder Freischaltcode $valxx : " . $operator_conf->{oprefix} . " " . $operator_conf->{database}->{dbname} . "\n" if($debug);
my $dbh_operator = $dbt->dbconnect_extern($operator_conf->{database}->{dbname});
#to get operator bonusnr
my $pref_bo = {
table => "content",
fetch => "one",
template_id => "228",
int03 => ">::0",
ct_name => "ilike::$bonusnr",
};
my $bonus_record = { c_id => 0, ct_name => "" };
$bonus_record = $dbt->fetch_record($dbh_operator,$pref_bo) if($bonusnr);
my $bonus_collect = {};#will be hash on matchin SWK bonus
#also if SWK file matches
if(!$bonus_record->{c_id} && $operator_conf->{database}->{dbname} eq "sharee_kn"){
$bonus_record->{ct_name} = $lb->grep_filecontent("$dbt->{copri_conf}->{basedir}/$operator_conf->{dir_app}/ftp/SWK_codes/got_last.csv","$bonusnr");
if($bonus_record->{ct_name}){
$bonus_record->{c_id} = 1;
$bonus_record->{int21} = 3429;#Stadtrad source Tarif
$bonus_record->{int22} = 3430;#Stadtrad target Tarif
$bonus_collect->{1}->{ct_name} = $bonus_record->{ct_name};
$bonus_collect->{1}->{int21} = 3429;
$bonus_collect->{1}->{int22} = 3430;
$bonus_collect->{2}->{ct_name} = $bonus_record->{ct_name};
$bonus_collect->{2}->{int21} = 3428;
$bonus_collect->{2}->{int22} = 3432;
$bonus_collect->{3}->{ct_name} = $bonus_record->{ct_name};
$bonus_collect->{3}->{int21} = 3433;
$bonus_collect->{3}->{int22} = 3434;
@txt30_op = ("$bonus_collect->{1}->{int22}","$bonus_collect->{2}->{int22}","$bonus_collect->{3}->{int22}");
}
print FILE "SWK bonus_collect:\n" . Dumper($bonus_collect) . "\n";
}
#add operators dbname only if Bonusnr matches
print FILE "txt15=$bonusnr requested on web Bonustarif on: $operator_conf->{database}->{dbname} --> Bonusnt:$bonus_record->{ct_name} --> int21:$bonus_record->{int21} --> int22:$bonus_record->{int22}\n" if($debug);
if($bonus_record->{c_id}){
$txt17{$operator_conf->{database}->{dbname}} = 1;
my @operators = ();
foreach my $keys (keys %txt17) {
push(@operators,$keys) if($keys =~/sharee_/);
}
print FILE "txt17 saving operators on primary: @operators\n" if($debug);
$update_adr->{txt17} = "@operators";
#collect operator addr with existing tariff setting
my $ctadr_operator = $dbt->fetch_record($dbh_operator,$authref);
@txt30_op = ("$ctadr_operator->{txt30}") if($ctadr_operator->{txt30});
@txt30_op = split(/\s+/,$ctadr_operator->{txt30}) if($ctadr_operator->{txt30} =~ /\w\s+\w/);
#operator request by Bonusnr.
#insert adr to operator if it doesn't exist before set operator bonustarif
if(!$ctadr_operator->{c_id}){
print FILE "Bonus oprefix address INSERT adr from record_primary to operator $operator_conf->{database}->{dbname} , c_id:$ctadr->{c_id}\n";
my $insert_op = {
%$ctadr,
table => "contentadr",
mtime => 'now()',
owner => "198",
};
my $c_id_op = $dbt->insert_contentoid($dbh_operator,$insert_op,"reset_adropkeys");
if($bonus_collect->{1}->{int22} && $bonus_collect->{2}->{int22} && $bonus_collect->{3}->{int22}){
@txt30_op = ("$bonus_collect->{1}->{int22}","$bonus_collect->{2}->{int22}","$bonus_collect->{3}->{int22}");
print FILE "SWK bonus_collect on adr insert:\n" . Dumper($bonus_collect) . "\n";
}elsif($bonus_record->{int22}){
@txt30_op = ("$bonus_record->{int22}");
print FILE "bonus_record on adr insert:\n" . Dumper($bonus_record) . "\n";
}
}
#address hash wit bonusnr
my $adr_bonus = {
table => "contentadr",
mtime => "now()",
c_id => $c_id,
txt15 => $bonusnr,
txt30_array => \@txt30_op,
owner => $owner,
ret => $ret,
};
$ctadr_operator = $dbt->fetch_record($dbh_operator,$authref);
print FILE "Bonusnr set_usertarif done by primary:\n" . Dumper($adr_bonus) . "\n";
$ret = $self->set_usertarif($dbh,$operator_conf->{database}->{dbname},$adr_bonus,$bonus_collect);
#count down only if not file greped with static kn c_id and not still used
print FILE "bonus_record update_content4comp by: $bonus_record->{c_id} > 3 && $bonus_record->{int03} > 0 && (!$ctadr_operator->{txt15} || $bonus_record->{ct_name} !~ /$ctadr_operator->{txt15}/i)\n";
if($bonus_record->{c_id} > 3 && $bonus_record->{int03} > 0 && (!$ctadr_operator->{txt15} || $bonus_record->{ct_name} !~ /$ctadr_operator->{txt15}/i)){
$dbt->update_content4comp($dbh_operator,$bonus_record->{c_id},"-","1");
}
}else{
$ret = "failure::txt15#top7";
}
}else{
$ret = "failure::txt15#top5";
}
}elsif($valxx && $valxx =~ /\w+/){
$ret = "failure::txt15#top6";
}
}
}
#sharee txt30=Tarif (multible) and Bonusnummer txt15 automatic
elsif($_ eq "txt30"){
#--> Only done by Operator DMS
if($varenv{dbname} ne $dbt->{primary}->{sharee_primary}->{database}->{dbname}){
my @txt30 = $q->param('txt30');#multiple select sharee Tarif
@txt30 = grep {!/null/} @txt30;
my $bonusnr = $q->escapeHTML("$R::txt15");#on Operator DMS without oprefix-
my $adr_bonus = {
table => "contentadr",
mtime => "now()",
c_id => $c_id,
txt15 => $bonusnr,
txt30_array => \@txt30,
owner => $owner,
ret => $ret,
};
print FILE "Bonusnr set_usertarif done by operator:\n" . Dumper($adr_bonus) . "\n";
$ret = $self->set_usertarif($dbh,$varenv{dbname},$adr_bonus,"");
}
#phonenr
}elsif($_ eq "txt07"){
$valxx =~ s/[\s\-\/]//g;
my $email = "";
my $phone = "";
$phone = $1 if($valxx =~ /([+0-9]+)/);
if(length($phone) < 9 || length($phone) > 16){
$ret = "failure::$_#top";
}else{
#smsAck reset
if($phone ne $ctadr->{txt07}){
$update_adr->{int13} = 0;
}
$update_adr->{$_} = "$phone";
$email = $q->escapeHTML("$R::txt08");
$email =~ s/\s//g;
my $confirm_digest = sha1_base64($email . $phone);
$confirm_digest =~ s/[I1LO0]//ig;
$update_adr->{txt34} = "$confirm_digest";
}
print FILE "confirm_digest input after substitution: $email . $phone\n" if($debug);
#user alias email
}elsif($_ eq "txt08"){
$valxx =~ s/\s//g;
if($valxx !~ /\w\@\w/){
$ret = "failure::$_#top";
}else{
my $pref_ac = {
table => "contentadr",
fetch => "one",
txt08 => "ilike::$valxx",
c_id => "!=::$c_id",
order => "mtime",
};
my $account_check = $dbt->fetch_tablerecord($dbh,$pref_ac);
print FILE "account_check email:$valxx, c_id:$account_check->{c_id} && $account_check->{c_id} != $c_id\n" if($debug);
if($account_check->{c_id} && $account_check->{c_id} != $c_id){
my $encoded_val = $uri_encode->encode($valxx);
$ret_conflict = "failure::conflict_$_=$encoded_val#top";
}
#mailAck reset
if($valxx ne $ctadr->{txt08}){
$update_adr->{int04} = 0;
}
$update_adr->{$_} = "$valxx";
}
}elsif($_ eq "int05"){#Web-login
$update_adr->{$_} = $valxx;
$update_adr->{txt05} = "" if($valxx != 1);#delete also cookies
}elsif($_ eq "int12" && $varenv{dbname} ne $dbt->{primary}->{sharee_primary}->{database}->{dbname}){
my $vde_on_fail = 0;
$vde_on_fail = 2 if($valxx && $valxx == 1);
$update_adr->{$_} = $vde_on_fail;
}elsif($_ =~ /^int03/){
#on payment-type change set vde=3 if no vaild user paymentdata available
if($ctadr->{int03} && $ctadr->{int03} != $valxx){
$update_adr->{$_} = $valxx;
my $rentable_check=0;
$rentable_check = $bw->isuser_rentable($ctadr);
$update_adr->{int12} = 3 if($rentable_check < 1);#than it will be set by payone response
}else{
$update_adr->{$_} = $valxx;
}
}elsif($_ =~ /^int|barcode/){
$update_adr->{$_} = $valxx;
}elsif($_ eq "ct_name" && $R::base_edit){
$update_adr->{$_} = "$valxx";
}elsif($_ =~ /txt22|txt23/){
$valxx =~ s/\s//g;
$update_adr->{$_} = "$valxx";
}elsif($_ !~ /ct_name|txt15/){
$update_adr->{$_} = "$valxx";
}
#Additionals after default updater
#on IBAN/BIC change set override Mandantsreferenz to c_id to trigger payone
if(($_ eq "txt22" && $valxx ne $ctadr->{txt22}) || ($_ eq "txt23" && $valxx ne $ctadr->{txt23})){
$update_adr->{ct_name} = "$c_id";
}
print FILE "-----> $_: $valxx\n" if($debug);
$ret = "failure::$_#top" if(($_ =~ /int14/) && ($valxx eq "null" || !$valxx));#sharee AGB
#Zahlungsart
$ret = "failure::$_#top" if(($_ =~ /int03/) && ($valxx eq "null" || !$valxx));
$ret = "failure::$_#top" if($_ =~ /txt01/ && $valxx !~ /[a-zäöü]+\s+[a-zäöü]+/i);
$ret = "failure::$_#top" if($_ =~ /txt03/ && ($valxx !~ /[\w|\.]+\s+\d+/ && $valxx !~ /\d+\s+[\w|\.]+/));
if($_ =~ /txt04/ && !$pw_dummy){
my $alphacount = 0;
my $alphafail = 0;
$alphacount = () = $valxx =~ /[a-z]/gi;
$alphafail = length($valxx) - $alphacount;
if(!$valxx || length($valxx) < 8 || $alphafail < 2){
$ret = "failure::$_#top";
}
}
$ret = "failure::$_#top" if($_ =~ /txt06/ && $valxx !~ /\d+\s+[a-zäöü]+/i);
$ret = "failure::$_#top" if($_ =~ /txt08/ && $valxx !~ /\w\@\w/);
$ret = "failure::$_#top" if($R::sharee_edit && $_ =~ /txt22/ && $valxx !~ /\w/);
$ret = "failure::$_#top" if($R::sharee_edit && $_ =~ /txt23/ && $valxx !~ /\w/);
}
print FILE "ret: $ret | ret_conflict: $ret_conflict\n" if($debug && ($ret || $ret_conflict));
}#end foreach keyword
$u_rows = 0;
#reread after update
if($ctadr->{c_id} > 0){
$u_rows = $dbt->update_record($dbh,$update_adr,$ctadr);
$ctadr = $dbt->fetch_record($dbh,$authref);
}
my $iban = $ctadr->{txt22} || "";
$iban =~ s/\s//g;
my $iban_reject = 0;
$iban_reject = 1 if($iban =~ /DE33700202700000091600/i);#fraud
if($R::request eq "managemandate" && $ctadr->{int03} == 1 && !$iban_reject){
my $vde_on_fail = $ctadr->{int12} || 3;#keep last or set 3
#check if iban from another user has Vde
my $pref_ac = {
table => "contentadr",
fetch => "one",
txt22 => "$iban",
int12 => ">=::1",
c_id => "!=::$c_id",
order => "mtime",
};
my $account_check = $dbt->fetch_tablerecord($dbh,$pref_ac);
print FILE "account_check iban:$iban, c_id:$account_check->{c_id} && $account_check->{c_id} != $c_id\n" if($debug);
if($account_check->{c_id} && $account_check->{c_id} != $c_id){
my $encoded_val = $uri_encode->encode($iban);
$ret_conflict = "failure::conflict_txt22\&txt22=$encoded_val#top";
}else{
my $payone_mival = $payone->managemandate_main(\%varenv,$ctadr,"",$owner);
if($payone_mival && $payone_mival =~ /\w{2}-\w+/){
#payment_ack
system("$dbt->{copri_conf}->{basedir}/$varenv{syshost}/src/scripts/payment_ack.pl '$varenv{syshost}' 'payment_ackSEPA' '$ctadr->{c_id}' '$owner' &");
$vde_on_fail = 0 if($vde_on_fail != 2);
$u_rows = $dbt->update_one($dbh,$update_adr,"int12=$vde_on_fail");#Vde
}else{
$u_rows = $dbt->update_one($dbh,$update_adr,"int12=$vde_on_fail");#Vde
$ret = "failure::txt22#top";
}
}
}
if($R::txt04 && $R::confirm_txt04 && $R::txt04 ne $R::confirm_txt04){
$ret = "failure::confirm_txt04#top";
}
if($ret =~ /failure::(\w+)/ && $ret !~ /txt15|txt16/){#persistent failure without Bonus or Gutschein
my $rval = $1;
#$rval =~ s/pwlazy_//g;#obsolet, all done in pw template description
$rval =~ s/confirm_//g;#PW confirm
$rval =~ s/conflict_//g;#conflict
print FILE "ret: $ret | rval: $rval\n" if($debug);
$dbt->update_one($dbh,$update_adr,"txt31='$rval'");
}elsif($fkeys =~ /$ctadr->{txt31}/){
print FILE " No failure and empty txt31 (fkeys: $fkeys =~ /$ctadr->{txt31}/) \n" if($debug);
$u_rows = $dbt->update_one($dbh,$update_adr,"txt31=''");
}
$ret = $ret_conflict if($ret_conflict);
print FILE "final ret: $ret \n" if($debug);
#operators_loop doesn't save operator specific data like int07 or int16, first save in operator
if($varenv{dbname} ne $dbt->{primary}->{sharee_primary}->{database}->{dbname}){
my $dbh_operator = $dbt->dbconnect_extern($varenv{dbname});
$u_rows = $dbt->update_record($dbh_operator,$update_adr,$ctadr);
}
#update operator with primary data after COPRI address edit
$dbt->update_operatorsloop($varenv{dbname},$ctadr->{c_id},"update");
$feedb->{u_rows} = $u_rows;
print FILE Dumper($feedb) . "\n" if($debug);
close(FILE) if($debug);
return ($ret,$feedb);
}#end save_account
#sharee Bonusnummer with Tarif automatic
sub set_usertarif {
my $self = shift;
my $dbh = shift;
my $dbname = shift;
my $adr_bonus = shift;
my $bonus_collect = shift || {};
my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime;
my %varenv = $cf->envonline();
my $debug=1;
open(FILE,">>$varenv{logdir}/save_account.log") if($debug);
print FILE "\n*set_usertarif --> $now_dt| dbname: $dbname | c_id: $adr_bonus->{c_id} | txt15: $adr_bonus->{txt15}\n" if($debug);
my $oprefix = $dbt->{operator}->{$dbname}->{oprefix};
my $ret = $adr_bonus->{ret};
my $i = 0;
my $dbh_operator = $dbt->dbconnect_extern($dbname);#operator connect
my $tariff_all = { barcode => 0, int18 => 0};
my $tariff = {
table => "content",
fetch => "all",
keyfield => "barcode",
template_id => "210",#Tariff tpl_id
};
$tariff_all = $dbt->fetch_record($dbh_operator,$tariff);
my $dbh_primary = $dbt->dbconnect_extern($dbt->{primary}->{sharee_primary}->{database}->{dbname});
my $adref = {
table => "contentadr",
fetch => "one",
template_id => "202",
c_id => "$adr_bonus->{c_id}",
};
my $adr_primary = { c_id => 0 };
$adr_primary = $dbt->fetch_record($dbh_primary,$adref) if($adr_bonus->{c_id});
#collect Tarif with prefix saving on primary
my %prim_tarif_hash = ();
if($adr_primary->{txt30} && $adr_primary->{txt30} =~ /\w\s\w/){
%prim_tarif_hash = map { $_ => 1 } split(/\s+/,$adr_primary->{txt30});
}elsif($adr_primary->{txt30}){
$prim_tarif_hash{$adr_primary->{txt30}} = 1;
}
#first delete operator tarif in prim_tarif_hash. we will fill up downunder
foreach my $rid (sort { $tariff_all->{$a}->{barcode} <=> $tariff_all->{$b}->{barcode} } keys (%$tariff_all)){
print FILE "--> Cleanup operator specific prim_tarif_hash: $tariff_all->{$rid}->{barcode}\n";
delete $prim_tarif_hash{$oprefix . $tariff_all->{$rid}->{barcode}};
}
if($adr_bonus->{txt15} =~ /\w+/){
if(1==1){
my %tarif_hash = ();
my @new_txt30 = ();
#collect multiple tarif by bonusnr
my $pref_cc = {
table => "content",
keyfield => "c_id",
fetch => "all",
template_id => "228",
int03 => ">::0",
ct_name => "ilike::$adr_bonus->{txt15}",
};
$bonus_collect = $dbt->fetch_record($dbh_operator,$pref_cc) if(ref($bonus_collect->{1}) ne "HASH");
foreach my $sourcetarif (@{$adr_bonus->{txt30_array}}){
$tarif_hash{$sourcetarif} = 1;
#additional and only! save privat or hidden tarif to primary to get caching
if($tariff_all->{$sourcetarif}->{int18} == 3 || $tariff_all->{$sourcetarif}->{int18} == 4){
$prim_tarif_hash{$oprefix . $sourcetarif} = 1;
}
}
print FILE "set_usertarif bonus_collect by request txt15: $adr_bonus->{txt15}\n";
foreach my $id (keys (%$bonus_collect)){
$i++;
print FILE "$i)-1-> loop bonus_collect and find $bonus_collect->{$id}->{ct_name} = $adr_bonus->{txt15}\n|==>Take and insert Tarif $bonus_collect->{$id}->{int22}\n" if($debug);
$tarif_hash{$bonus_collect->{$id}->{int22}} = 1;
#additional and only! save privat or hidden tarif to primary to get caching
if($tariff_all->{$bonus_collect->{$id}->{int22}}->{int18} == 3 || $tariff_all->{$bonus_collect->{$id}->{int22}}->{int18} == 4){
$prim_tarif_hash{$oprefix . $bonus_collect->{$id}->{int22}} = 1;
}
if($bonus_collect->{$id}->{int21} && $bonus_collect->{$id}->{int21} != $bonus_collect->{$id}->{int22}){
print FILE "$i)-2-> delete if($bonus_collect->{$id}->{int21} && $bonus_collect->{$id}->{int21} != $bonus_collect->{$id}->{int22})\n" if($debug);
delete $tarif_hash{$bonus_collect->{$id}->{int21}};
delete $prim_tarif_hash{$oprefix . $bonus_collect->{$id}->{int21}};
print FILE "$i)-3-> delete done $bonus_collect->{$id}->{int21}\n" if($debug);
}
}
@new_txt30 = keys %tarif_hash;
if(@new_txt30){
print FILE "Final -3-> txt30: @new_txt30\n" if($debug);
$u_rows = $dbt->update_one($dbh_operator,$adr_bonus,"txt30='@new_txt30'");
$u_rows = $dbt->update_one($dbh_operator,$adr_bonus,"txt15='$adr_bonus->{txt15}'");
#collect Tarif with prefix saving on primary
my @prim_txt30 = keys %prim_tarif_hash;
$u_rows = $dbt->update_one($dbh_primary,$adr_bonus,"txt30='@prim_txt30'");
}
$ret = "failure::txt30#top2" if(!$adr_bonus->{txt30_array} || $adr_bonus->{txt30_array} !~ /\d/);
}
}else{
print FILE "-4-> update Tarif txt30: @{$adr_bonus->{txt30_array}}\n" if($debug);
$u_rows = $dbt->update_one($dbh_operator,$adr_bonus,"txt30='@{$adr_bonus->{txt30_array}}'");
$u_rows = $dbt->update_one($dbh_operator,$adr_bonus,"txt15=''");
#collect Tarif with prefix saving on primary
#delete bonus tarif on primary if not defined by operator
#additional and only! save privat or hidden tarif to primary to get caching
foreach my $rid (sort { $tariff_all->{$a}->{barcode} <=> $tariff_all->{$b}->{barcode} } keys (%$tariff_all)){
foreach(@{$adr_bonus->{txt30_array}}){
if($tariff_all->{$rid}->{barcode} == $_ && ($tariff_all->{$_}->{int18} == 3 || $tariff_all->{$_}->{int18} == 4)){
print FILE "--> Adding private/hidden key on operator to primary: $_\n";
$prim_tarif_hash{$oprefix . $_} = 1;
}
}
}
my @prim_txt30 = keys %prim_tarif_hash;
$u_rows = $dbt->update_one($dbh_primary,$adr_bonus,"txt30='@prim_txt30'");
$ret = "failure::txt30#top3" if(!$adr_bonus->{txt30_array} || $adr_bonus->{txt30_array} !~ /\d/);
}
#if bonus value doesn't match
if($adr_bonus->{txt15} && $i == 0){
print FILE "-5-> failure txt15: ''\n" if($debug);
$ret = "failure::txt15#top4";
}
close(FILE) if($debug);
return $ret;
}#end set_usertarif
#coupon alias Gutschein
sub save_transact(){
my $self = shift;
my $q = shift;
my $c_id = shift || "";
my $coo = shift || "";
my $owner = shift || "";
$q->import_names('R');
my @keywords = $q->param;
my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime;
my %varenv = $cf->envonline();
$bw->log("save_transact",$q,"");
my $debug=1;
my $dbh = "";#keep in mind, empty dbh defaults to local copri-instance dbname
open(FILE,">>$varenv{logdir}/save_account.log") if($debug);
print FILE "\n*-->local copri-Instance DB $varenv{dbname} $now_dt| c_id: $c_id \n" if($debug);
my $authref = {
table => "contentadr",
fetch => "one",
template_id => "202",
c_id => "$c_id",
};
my $ctadr = $dbt->fetch_record($dbh,$authref);
my $pos_id="";
my $ret;
my $fkeys;
foreach(@keywords){
$fkeys .= "$_,";
my $val = $q->param($_);
my $valxx = $q->escapeHTML("$val");
#print "|$_: $valxx";
$valxx =~ s/^\s+//;
$valxx =~ s/\s+$//;
#Gutschein
if($_ eq "txt16"){
#forgotten prefix workaround
$valxx = "SX-" . $valxx if($valxx =~ /sigoinpassau|EMW2022/i && $valxx !~ /^SX-/i);
print FILE "Gutschein request $_: $valxx\n" if($debug);
if($valxx && $valxx =~ /^(\w{2,3})-(\w+)/){
$valxx =~ s/\s//g;
my $coupon_prefix = uc($1),
my $coupon_nr = $2;
my $operator_conf = $dbt->get_operator_conf($coupon_prefix);
if(ref($operator_conf) eq "HASH" && $operator_conf->{oprefix} && $operator_conf->{database}->{dbname}){
print FILE "Gutschein $valxx : " . $operator_conf->{oprefix} . " " . $operator_conf->{database}->{dbname} . "\n" if($debug);
my $dbh_operator = $dbt->dbconnect_extern($operator_conf->{database}->{dbname});
#to get operator coupon_nr
my $pref_co = {
table => "content",
fetch => "one",
template_id => "224",
int03 => ">::0",
ct_name => "ilike::$coupon_nr",
};
my $ct = { c_id => 0 };
$ct = $dbt->fetch_record($dbh_operator,$pref_co);
$ct->{int02} *= -1 if($ct->{int02} > 0);#coupon price must be negate
print FILE "txt16=$coupon_nr, unit_price $ct->{int02} --> requested on web on: $operator_conf->{database}->{dbname} --> barcode:$ct->{barcode}\n" if($debug);
if($ct->{c_id}){
my $ctadr_operator = { c_id => 0 };
$ctadr_operator = $dbt->fetch_record($dbh_operator,$authref);
if(!$ctadr_operator->{c_id}){
my %operator_hash = ();
if($ctadr->{txt17} && $ctadr->{txt17} =~ /\w\s\w/){#append DB's
%operator_hash = map { $_ => 1 } split(/\s+/,$ctadr->{txt17});
}elsif($ctadr->{txt17}){
$operator_hash{$ctadr->{txt17}} = 1;
}
$operator_hash{$operator_conf->{database}->{dbname}} = 1;
my @operator_array = keys %operator_hash;
$bw->log("save_transact update operator keys by array: @operator_array",\%operator_hash,"");
print FILE "save_transact update operator keys by array: @operator_array | pri $ctadr->{c_id}\n" if($debug);
my $update_primary = {
table => "contentadr",
txt17 => "@operator_array",#operator ids
txt19 => "$operator_conf->{database}->{dbname}",
atime => "now()",
owner => "198",#update initiated by primary
};
my $rows = $dbt->update_record($dbh,$update_primary,$ctadr);
print FILE "Gutschein oprefix address INSERT adr from record_primary to operator $operator_conf->{database}->{dbname} , c_id:$ctadr->{c_id}\n";
my $insert_op = {
%$ctadr,
table => "contentadr",
mtime => 'now()',
owner => "198",
};
my $c_id_op = $dbt->insert_contentoid($dbh_operator,$insert_op,"reset_adropkeys");
}
$ctadr_operator = $dbt->fetch_record($dbh_operator,$authref);
if($ctadr_operator->{c_id} > 0){
my $pref = {
table => "contenttrans",
fetch => "one",
main_id => 300008,
template_id => 218,
int10 => "$ctadr_operator->{c_id}",
state => "is::null",
close_time => "is::null",
};
my $ctt = { c_id => 0 };
$ctt = $dbt->fetch_record($dbh_operator,$pref);
my $posref = {
table => "contenttrans",
table_pos => "contenttranspos",
fetch => "one",
keyfield => "c_id",
ca_id => "$ctadr->{c_id}",
ct_name => "ilike::$valxx",
};
my $cttpos = { c_id => 0 };
$cttpos = $dbt->collect_post($dbh_operator,$posref);
#check if user has still coupon used
if(!$cttpos->{c_id}){
if($ctt->{c_id} > 0){
$pos_id = $dbt->insert_pos($dbh_operator,$ctt->{c_id},$ct,"",$ctadr_operator,"","",$valxx,"0",$owner,"");
}else{
my $ct_id = {c_id => 0};
$ct_id = $dbt->insert_contenttrans($dbh_operator,$ctadr_operator,"300008","218","----",$owner);
$pos_id = $dbt->insert_pos($dbh_operator,$ct_id,$ct,"",$ctadr_operator,"","",$valxx,"0",$owner);
}
}else{
$ret = "failure::conflict_txt16#top";
}
if($pos_id){
$ret = "success::txt16";
$dbt->update_content4comp($dbh_operator,$ct->{c_id},"-","1");
}
}else{
$ret = "failure::txt16#top";
}
}else{
$ret = "failure::txt16#top";
}
}
}elsif($valxx && $valxx =~ /\w+/){
$ret = "failure::txt16#top";
}
}
}
print FILE "save_transact ret: $ret \n" if($debug);
close(FILE) if($debug);
return $ret;
}#end save_transact
#Send sms after payable check and !int13
sub smsack {
my $self = shift;
my $ctadr = shift;
$smstrans->sms_ack_digest($ctadr);
return;
}
#Send email after payable check and !int04
sub emailack {
my $self = shift;
my $varenv = shift;
my $adr_id = shift || "";
system("$dbt->{copri_conf}->{basedir}/$varenv->{syshost}/src/scripts/mailTransportcms.pl '$varenv->{syshost}' 'send_emailack' '$adr_id' ''");
return;
}
#email and sms acknowledgments, check and save confirm code states
sub code_confirmation {
my $self = shift;
my $q = shift;
my $varenv = shift;
my $aowner = shift;
$q->import_names('R');
my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime;
my $dbh_primary = $dbt->dbconnect_extern($dbt->{primary}->{sharee_primary}->{database}->{dbname});
my $update_adr = {
table => "contentadr",
mtime => "now()",
owner => $aowner,
};
#keep in mind, for now and just for testing confirm codes are just c_id
open(FILE,">>$varenv->{logdir}/confirm.log");
print FILE "\n\n*--> $now_dt done by code_confirmation\n";
print FILE "confirm_userid:$R::confirm_userid\nconfirm_code:$R::confirm_code\nconfirm_smscode:$R::confirm_smscode\n";
$R::confirm_code =~ s/\s//g;
$R::confirm_smscode =~ s/\s//g;
my $confirm_code = $q->escapeHTML($R::confirm_code);
my $confirm_smscode = $q->escapeHTML($R::confirm_smscode);
#confirm email
if($confirm_code){
my $authref = {
table => "contentadr",
fetch => "one",
c_id => $R::confirm_userid,
txt34 => "ilike::$confirm_code%",
};
my $confirmed_email = { c_id => 0 };
$confirmed_email = $dbt->fetch_tablerecord($dbh_primary,$authref);
if($confirmed_email->{c_id}){
$update_adr->{c_id} = $confirmed_email->{c_id};
$dbt->update_one($dbh_primary,$update_adr,"int04=1");
#save verified emailcode
$dbt->update_one($dbh_primary,$update_adr,"txt32='$confirmed_email->{txt08}'");
print FILE "confirmed_email: $confirmed_email->{c_id} update because confirm_code:$confirm_code\n";
#after mailAck, delete all douple adr with no mailAck
my $authref = {
table => "contentadr",
fetch => "all",
keyfield => "c_id",
txt08 => "ilike::" . $q->escapeHTML($confirmed_email->{txt08}),
};
my $ctadr = $dbt->fetch_tablerecord($dbh_primary,$authref);
foreach my $aid (keys(%$ctadr)){
if(!$ctadr->{$aid}->{int04}){
$dbt->delete_content("contentadr",$ctadr->{$aid}->{c_id});
print FILE "c_id $ctadr->{$aid}->{c_id} $confirmed_email->{txt08} delete because of dopplel\n";
}
}
}
}
#confirm sms
if($confirm_smscode){
my $authref = {
table => "contentadr",
fetch => "one",
c_id => $R::confirm_userid,
txt34 => "ilike::%$confirm_smscode",
};
my $confirmed_sms = { c_id => 0 };
$confirmed_sms = $dbt->fetch_tablerecord($dbh_primary,$authref);
if($confirmed_sms->{c_id}){
$update_adr->{c_id} = $confirmed_sms->{c_id};
$dbt->update_one($dbh_primary,$update_adr,"int13=1");
#save verified smscode
$dbt->update_one($dbh_primary,$update_adr,"txt33='$confirmed_sms->{txt07}'");
print FILE "confirmed_sms: $confirmed_sms->{c_id} update because confirm_smscode:$confirm_smscode\n";
}
}
close(FILE);
return;
}#end code_confirmation
#Password forgotten send email
sub send_password {
my $self = shift;
my $varenv = shift;
my $email = shift || "";
my $coo = shift || "";
my $owner = shift || "";
my $dbh = "";
$email = $q->escapeHTML($email);
$email =~ s/\s//g;
my $pwmd5 = md5_hex($coo) || "";
if($email && $email =~ /\w\@\w/ && $pwmd5 && length($pwmd5) > 20 && $email !~ /$dbt->{copri_conf}->{test_accounts}/i){
my $pwsha256=sha256_base64($pwmd5) || "";
my $authref = {
table => "contentadr",
fetch => "one",
template_id => "202",
txt08 => "ilike::" . $q->escapeHTML($email),
int05 => "1",
};
my $ctadr = { c_id => 0 };
$ctadr = $dbt->fetch_record($dbh,$authref);
my $c_id = $ctadr->{c_id};
my $update_primary = {
table => "contentadr",
mtime => "now()",
owner => "$owner",
txt04 => "$pwsha256",
int06 => 1,
};
if($c_id > 0){
my $dbh_primary = $dbt->dbconnect_extern($dbt->{primary}->{sharee_primary}->{database}->{dbname});
$dbt->update_record($dbh_primary,$update_primary,$ctadr);
$dbt->update_operatorsloop($varenv->{dbname},$c_id,"update");
system("$dbt->{copri_conf}->{basedir}/$varenv->{syshost}/src/scripts/mailTransportcms.pl '$varenv->{syshost}' 'send_password' '$c_id' '' '$coo'");
}
}
return;
}
#sigbike just like caching and not realy used by app
sub sigbike_cupdate {
my $self = shift;
my $record_sig = shift;
my $dbh = "";
my $rows = 0;
foreach my $bid (keys (%$record_sig)){
my $update = {
%{$record_sig->{$bid}},
table => "content",
template_id => "205",
#main_id => "300102",#set by APIsigclient
mtime => "now()",
owner => "169",
};
$rows = $dbt->update_record($dbh,$update,$record_sig->{$bid});
$bw->log("rows: $rows | sigbike_cupdate content from record_sig with bike nr:",$update,"");
if($rows != 1){
my $c_id = "";
$update->{itime} = "now()";
$bw->log("INSERT content from record_sig with bike nr:",$update,"");
$c_id = $dbt->insert_contentoid($dbh,$update,"");
$rows = 1 if($c_id);
}
}
return $rows;
}
#sigstation just like caching and not realy used by app
sub sigstation_cupdate {
my $self = shift;
my $record_sig = shift;
my $dbh = "";
my $rows = 0;
foreach my $sid (keys (%$record_sig)){
my $update = {
%{$record_sig->{$sid}},
table => "content",
template_id => "225",
main_id => "300016",
mtime => "now()",
owner => "169",
};
$rows = $dbt->update_record($dbh,$update,$record_sig->{$sid});
$bw->log("rows: $rows | sigstation_cupdate content from record_sig with bike nr:",$update,"");
if($rows != 1){
my $c_id = "";
$update->{itime} = "now()";
$bw->log("INSERT content from record_sig with bike nr:",$update,"");
$c_id = $dbt->insert_contentoid($dbh,$update,"");
$rows = 1 if($c_id);
}
}
return $rows;
}
1;