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;