package Shareework; # # SPDX-License-Identifier: AGPL-3.0-or-later # Copyright (c) Rainer Gümpelein, TeilRad GmbH # #disable for syntax check #use lib qw(/var/www/copri4/shareeapp-primary/src); use strict; use warnings; use POSIX; use CGI; # only for debugging use Mod::Libenzdb; 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); use Scalar::Util qw(looks_like_number); use URI::Encode; use Mod::Prelib; use Mod::Basework; use Mod::Payment; #use Mod::MailTransport; use Mod::SMSTransport; use Data::Dumper; my $cf = new Config; my $but = new Buttons; my $db = new Libenzdb; my $lb = new Libenz; my $dbt = new DBtank; my $apif = new APIfunc; my $pl = new Prelib; 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("sharee_primary"); 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 "sharee_primary"){ $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"; } sub check_account(){ my $self = shift; my ($column2,$op2,$content2,$column3,$op3,$content3) = @_; my $table = "contentadr"; $content2 = $q->escapeHTML("$content2"); my $account_check = $db->get_like2sort("contentadr","","","$column2","$op2","$content2","$column3","$op3","$content3"); return $account_check; } #create_account is alwas done on primary first sub create_account(){ my $self = shift; my $owner = shift; my $table = "contentadr"; my $c_idnew = $db->insert_content($table); $db->updater("$table","c_id",$c_idnew,"ct_name","$c_idnew","$owner"); $db->updater("$table","c_id",$c_idnew,"barcode","$c_idnew","$owner"); $db->updater("$table","c_id",$c_idnew,"int20","$owner","$owner"); my $rel_idnew = $db->insert_relationlist($table,"200011","de",$c_idnew,"202","ca_id"); return $c_idnew; } #sharee save_account is always done on primary first sub save_account(){ my $self = shift; my $c_id = shift; my $varmerch = shift || ""; my $owner = shift || 0; my $table = "contentadr"; $q = new CGI; $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_account by varmerchant_id $varmerch->{merchant_id} on dbname $varenv{dbname}",$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); #Always on sharee_primary if($varenv{dbname} ne "sharee_primary"){ $dbh = $dbt->dbconnect_extern("sharee_primary"); print FILE "\n*-->If no-primary connect DB sharee_primary (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 = $dbt->fetch_record($dbh,$authref); my $update_primary = { 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+$//; print FILE "$_:$valxx \n" if($debug); if($_ =~ /^int|barcode/){ $valxx =~ s/,/./g; if(looks_like_number($valxx)){ $valxx = $valxx; }else{ $valxx = "null" } } if($_ =~ /^txt[\d+]|^int[\d+]|^uri[\d+]|ct_name/){ #PW if($_ =~ /^txt04/){ if($valxx eq "xxxxxxxx"){ $pw_dummy = "1"; }elsif($valxx){ my $pwmd5 = md5_hex($valxx); $u_rows = $dbt->update_one($dbh,$update_primary,"txt11='$pwmd5'"); } } #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); } $u_rows = $dbt->update_one($dbh,$update_primary,"txt17='@operators'"); } #Web-Login|Rabatt|Vde|payone cron-intervall|Ilockit-Admin #elsif($_ =~ /int05|int07|int16|int19/){ elsif($_ =~ /int05|int07|int16|int19/){ $u_rows = $dbt->update_one("",$update_primary,"$_=$valxx"); } #user_tour elsif($_ =~ /txt18/){ my @txt18 = $q->param('txt18'); @txt18 = grep {!/null/} @txt18; $u_rows = $dbt->update_one("",$update_primary,"$_='@txt18'"); } #Text Sonstiges elsif($_ =~ /txt29/){ $u_rows = $dbt->update_one("",$update_primary,"$_='$valxx'"); } #txt15=Bonus- oder Antragsnummer (falls vorhanden)=15 #only check bonusnr and add operators dbname. #bonustarif will be set after operator insert elsif($_ eq "txt15"){ #only done by App web iframe Anmelde-Registration formular print FILE "Bonusnr request $_: $valxx\n" if($debug); if($varenv{dbname} eq "sharee_primary"){ my %txt17 = (); if($ctadr->{txt17} =~ /\w\s\w/){ %txt17 = map { $_ => 1 } split(/\s+/,$ctadr->{txt17}); }else{ $txt17{$ctadr->{txt17}} = 1; } #accept SWK codes without prefix if($valxx && $owner && ($owner == 195 || $owner == 185 || $owner == 176 || $varenv{dbname} eq "sharee_kn")){ my $valappend = $valxx; $valxx = "KN-$valappend"; print FILE "Prepare SWK Bonusnr by prefix $valxx" . "\n" if($debug); } if($valxx && ($valxx =~ /^(\w{2,3})-(\w+)/ || $valxx =~ /^(\w{2,3})(\d+)/)){ $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 Antragsnummer $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 => "$bonusnr", }; my $bonus_record = $dbt->fetch_record($dbh_operator,$pref_bo); 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; @txt30_op = ("$bonus_collect->{1}->{int22}","$bonus_collect->{2}->{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); $u_rows = $dbt->update_one($dbh,$update_primary,"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_record->{c_id} > 3){#means if not file greped with static c_id <= 3 $dbt->update_content4comp($dbh_operator,$bonus_record->{c_id},"-","1"); } if($bonus_collect->{1}->{int22} && $bonus_collect->{2}->{int22}){ @txt30_op = ("$bonus_collect->{1}->{int22}","$bonus_collect->{2}->{int22}"); print FILE "SWK bonus_collect on adr insert:\n" . Dumper($bonus_collect) . "\n"; }elsif($bonus_record->{int22}){ @txt30_op = ("$bonus_record->{int22}"); } } #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, }; print FILE "operator adr update preview with bonusnr:\n" . Dumper($adr_bonus) . "\n"; $ret = $pl->set_usertarif($dbh,$operator_conf->{database}->{dbname},$adr_bonus,$bonus_collect); }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 "sharee_primary"){ 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 $bonushash = { table => "contentadr", mtime => "now()", c_id => $c_id, txt15 => $bonusnr, txt30_array => \@txt30, owner => $owner, ret => $ret, }; $ret = $pl->set_usertarif($dbh,$varenv{dbname},$bonushash); } #phonenr }elsif($_ eq "txt07"){ $valxx =~ s/[\s\-\/]//g; if($valxx !~ /\d{9}/ || length($valxx) > 16){ $ret = "failure::$_#top"; }else{ #smsAck reset if($valxx ne $ctadr->{txt07}){ $u_rows = $dbt->update_one($dbh,$update_primary,"int13=0"); } $u_rows = $dbt->update_one($dbh,$update_primary,"$_='$valxx'"); my $email = $R::txt08; $email =~ s/\s//g; my $confirm_digest = sha1_base64($email . $valxx); $u_rows = $dbt->update_one($dbh,$update_primary,"txt34='$confirm_digest'"); } #user alias email }elsif($_ eq "txt08"){ $valxx =~ s/\s//g; if($valxx !~ /\w\@\w/){ $ret = "failure::$_#top"; }else{ my $account_check = &check_account("","txt08","ilike",$valxx,"c_id","!=",$c_id); print FILE "$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}){ $u_rows = $dbt->update_one($dbh,$update_primary,"int04=0"); } $u_rows = $dbt->update_one($dbh,$update_primary,"$_='$valxx'"); } }elsif($_ eq "int12"){ if($varenv{dbname} eq "sharee_primary"){ $u_rows = $dbt->update_one($dbh,$update_primary,"$_=2"); }else{ $u_rows = $dbt->update_one($dbh,$update_primary,"$_=$valxx"); } }elsif($_ =~ /^int|barcode/){ $u_rows = $dbt->update_one($dbh,$update_primary,"$_=$valxx"); }elsif($_ eq "ct_name" && $R::base_edit){ $u_rows = $dbt->update_one($dbh,$update_primary,"$_='$valxx'"); #}elsif($_ !~ /ct_name|txt22|txt23|txt15/){ }elsif($_ !~ /ct_name|txt15/){ $u_rows = $dbt->update_one($dbh,$update_primary,"$_='$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})){ $u_rows += $dbt->update_one($dbh,$update_primary,"ct_name='$c_id'"); } if($_ =~ /txt22/ && $valxx){ my $currency = "EUR"; $currency = "CHF" if($valxx =~ /^(CH)/i); $u_rows = $dbt->update_one($dbh,$update_primary,"txt24='$currency'"); } 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::pwlazy_txt04#top"; $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 #payone only if SEPA Mandat checked #Testbuchhung mit 1 € preauthorization and 0 € capture $ctadr = $dbt->fetch_record($dbh,$authref); print FILE "+++ $R::request && $ctadr->{int03} == 1 && $ctadr->{ct_name} eq $ctadr->{c_id} \n" if($debug); if($R::request eq "managemandate" && $ctadr->{int03} == 1 && $ctadr->{ct_name} eq $ctadr->{c_id}){ my $vde_on_fail = $ctadr->{int12} || 3;#keep last or set 3 my $payone_mival = $payone->managemandate_main(\%varenv,$ctadr,"",$owner); if($payone_mival && $payone_mival =~ /\w{2}-\d+/){ #define fictiv invoice to get 1 € test my $epoche = time(); my $ctt = { c_id => 1, int01 => 0, int15 => 1, txt16 => "", reference => "$ctadr->{c_id}_$epoche", payone_reset => '' }; my $payone_txid = ""; ##preauthorization and/or capture needs to much time, must be done async! #$payone_txid = $payone->preauthorizationSEPA_main(\%varenv,$ctadr,$ctt,$owner); #if($payone_txid) if(1==1){ $ctt->{txt16} = "$payone_txid"; $u_rows = $dbt->update_one($dbh,$update_primary,"int12=0");#Vde #$payone_txid = $payone->captureSEPA_main(\%varenv,$ctadr,$ctt,$owner); #int12=0 should be set after capture success in payment module }else{ $u_rows = $dbt->update_one($dbh,$update_primary,"int12=$vde_on_fail");#Vde } }else{ $u_rows = $dbt->update_one($dbh,$update_primary,"int12=$vde_on_fail");#Vde } #$u_rows = $dbt->update_one($dbh,$update_primary,"int12=3");#Vde test fail } 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_primary,"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_primary,"txt31=''"); } $ret = $ret_conflict if($ret_conflict); print FILE "final ret: $ret \n" if($debug); close(FILE) if($debug); #if(!$ret){#we do it also on failures to get sync #update operator with primary data after COPRI address edit $dbt->update_operatorsloop($varenv{dbname},$ctadr->{c_id},"update"); return ($ret,"$i_rows-$u_rows-$d_rows"); } #insert/save/delete DMS users sub manage_dmsusers { my $self = shift; my $base_edit = shift; my $u_id = shift; my $users_dms = shift || {}; my $owner = $users_dms->{u_id} || 0; my $table = "users"; $q = new CGI; $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("manage_dmsusers",$q,""); my $dbh = ""; my $authref = { table => "contentadr", fetch => "one", template_id => "202", c_id => "$u_id", }; my $ctadr = $dbt->fetch_record($dbh,$authref); #users have to be exist only if DMS activated my $uref = { table => "users", fetch => "one", u_id => "$u_id", }; my $users = $dbt->fetch_tablerecord($dbh,$uref); #datahash on update my $dmsusers = { table => "users", mtime => "now()", owner => "$owner", u_id => "$u_id", }; if(ref($users) eq "HASH" && $users->{u_id} && (!$ctadr->{c_id} || $base_edit eq "delete_dmsusers")){ $bw->log("delete DMS user from $varenv{dbname}",$ctadr->{c_id},""); $d_rows += $dbt->delete_content($dbh,"users",$u_id); }elsif(ref($users) eq "HASH" && $users->{u_id} && $ctadr->{c_id} && $ctadr->{c_id} == $users->{u_id} && $base_edit eq "save_dmsusers"){ $bw->log("update DMS user to $varenv{dbname}",$ctadr->{c_id},""); foreach(@keywords){ my $val = $q->param($_); my $valxx = $q->escapeHTML("$val"); $valxx =~ s/^\s+//; $valxx =~ s/\s+$//; if($_ =~ /^int\d+/){ $valxx =~ s/,/./g; #$valxx = "null" if(!looks_like_number($valxx));#empty $valxx = 0 if(!looks_like_number($valxx));# set to 0 for using == operator $u_rows = $dbt->update_one($dbh,$dmsusers,"$_=$valxx"); } } }elsif($ctadr->{c_id} && !$users->{u_id} && $base_edit eq "new_dmsusers"){ $bw->log("insert DMS user to $varenv{dbname}",$ctadr->{c_id},""); $i_rows = $dbt->insert_users($dbh,$ctadr->{c_id},$owner); } return "$i_rows-$u_rows-$d_rows"; } #coupon alias Gutschein sub save_transact(){ my $self = shift; my ($c_id,$coo,$owner) = @_; $q = new CGI; $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 $update_primary = { table => "contentadr", mtime => "now()", owner => "$owner", c_id => "$c_id", }; 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"){ print FILE "Gutschein request $_: $valxx\n" if($debug); if($valxx && ($valxx =~ /^(\w{2,3})-(\w+)/ || $valxx =~ /^(\w{2,3})(\d+)/)){ $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}){ 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,#must be Rechnung (and not Storno) template_id => 218, #ca_id => "$ctadr->{c_id}", int10 => "$ctadr_operator->{c_id}", state => "is::null", close_time => "is::null", }; my $ctt = { c_id => 0 }; $ctt = $dbt->fetch_record($dbh_operator,$pref); if($ctt->{c_id} > 0){ #TODO, fetch coupon in user context to restrict mass inserts $pos_id = $dbt->insert_pos($dbh_operator,$ctt->{c_id},$ct,$ctadr_operator,"",$now_dt,$ct->{ct_name},"0",$owner); }else{ my $ct_id = $dbt->insert_contenttrans($dbh_operator,$ctadr_operator,"300008","218","----",$owner); $pos_id = $dbt->insert_pos($dbh_operator,$ct_id,$ct,$ctadr_operator,"",$now_dt,$ct->{ct_name},"0",$owner); } 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 #online net bike booking #Used by APP API sub net_booking(){ my $self = shift; my $auth = shift;#API auth my $bikeIDin = shift;#API request my $owner = shift; my $gps = shift || ""; my $c_id = $auth->{c_id}; $bikeIDin =~ s/\s//g; my $bikeID = $q->escapeHTML($bikeIDin) if($bikeIDin =~ /\d+$/); my $db_bike = $bikeID; $db_bike = $1 if($db_bike =~ /(\d+)/); my %varenv = $cf->envonline(); my $ctf = $db->get_content1("contentuser",$dbt->{shareedms_conf}->{parent_id}); my $pos_id=""; my $return=0; my $now_dt = strftime "%Y-%m-%d %H:%M", localtime; my $dbh = ""; my $response_state = "OK"; my $response_text = ""; $bw->log("net_booking booking_request bikeIDin $bikeIDin, authID $auth->{c_id}","",""); my $ctadr = $db->get_contentrow("contentadr",$auth->{c_id}); my $update_adr = { table => "contentadr", mtime => "now()", owner => "$owner", c_id => "$ctadr->{c_id}", }; my $pref = { table => "contenttrans", fetch => "one", main_id => 300008, template_id => 218, #ca_id => "$ctadr->{c_id}",#TODO int10 => "$ctadr->{c_id}", state => "null", close_time => "is::null", }; my $main_ids; my ($bike_group,$user_group,$tariff_content,$user_tour) = $apif->fetch_tariff($ctadr,""); $main_ids = join(",",@{$bike_group}); $main_ids =~ s/[a-z_]+//ig; my $ct = {}; my $pref_cc = { table => "content", fetch => "one", main_id => "IN::($main_ids)", barcode => $db_bike, int10 => 1, }; $ct = $dbt->fetch_record($dbh,$pref_cc) if($main_ids); #$tariff_nr in contentadr are saved by COPRI OR user Tarif-Select!!! #This is the automatic user tariff setter my $tariff_nr = ""; my @adr_tariff = (); if($ctadr->{txt30}){ @adr_tariff = ("$ctadr->{txt30}"); @adr_tariff = split(/\s+/,$ctadr->{txt30}) if($ctadr->{txt30} =~ /\w\s+\w/); } if(ref($ct) eq "HASH" && $ct->{main_id}){ foreach my $id (keys (%$tariff_content)){ foreach(@adr_tariff){ $bw->log("adr_tariff array form $ctadr->{txt30}",$_,""); if($tariff_content->{$id}->{int12} && $tariff_content->{$id}->{int12} == $ct->{main_id} && $tariff_content->{$id}->{barcode} && $_ == $tariff_content->{$id}->{barcode}){ $bw->log("1. net_booking tariff loop matches:",$tariff_content->{$id}->{barcode},""); $tariff_nr = $tariff_content->{$id}->{barcode}; } } } #2021-07-10, if no tarif then update user account to fallback default public or private or hidden tarif #if(!$tariff_nr && !$ctadr->{txt30}) if(!$tariff_nr){ my @txt30 = (); foreach my $id (keys (%$tariff_content)){ # #int18 # # 2 = "public" # 3 = "private" # 4 = "hidden-lv" # if($tariff_content->{$id}->{int18} && ($tariff_content->{$id}->{int18} == 2 || $tariff_content->{$id}->{int18} == 3 || $tariff_content->{$id}->{int18} == 4)){ #auto set tarif if requested bike matches flot if($tariff_content->{$id}->{int12} && $tariff_content->{$id}->{int12} == $ct->{main_id} && $tariff_content->{$id}->{barcode}){ $bw->log("2. net_booking tariff loop matches:",$tariff_content->{$id}->{barcode},""); $tariff_nr = $tariff_content->{$id}->{barcode}; push(@txt30, "$tariff_content->{$id}->{barcode}"); }#add also other public tarif elsif($tariff_content->{$id}->{int18} && $tariff_content->{$id}->{int18} == 2 && $tariff_content->{$id}->{int12} && $tariff_content->{$id}->{barcode}){ push(@txt30, "$tariff_content->{$id}->{barcode}"); } } } $bw->log("--> NO user tariff defined, update user account to fallback default public or private or hidden",\@txt30,""); $dbt->update_one($dbh,$update_adr,"txt30='@txt30'"); }else{ $bw->log("--> user tariff selected",$tariff_nr,""); } } $bw->log("---> bike $ct->{barcode} matching by bike_group: @{$bike_group} main_ids:$main_ids | user_group:@{$user_group} | Tarif selected: $tariff_nr",$tariff_content->{$tariff_nr},""); if($ct->{c_id} && $tariff_nr){ my $ctt; my $payoneable_check=0; if(($ctadr->{int03} == 1 && $ctadr->{ct_name} =~ /\w{2}-\d+/ && $ctadr->{ct_name} !~ /LV-\d+/) || ($ctadr->{int03} == 2 && length($ctadr->{ct_name}) >= 19) || ($ctadr->{int03} == 1 && $varenv{dbname} eq "sharee_lv" && $ctadr->{ct_name} =~ /LV-\d+/)){ $payoneable_check=1; }else{ $response_state="Failure 1006: There is no valid payment methode"; $response_text="Bitte überprüfen Sie Ihre Profildaten auf Vollständigkeit, nur dann können wir das Fahrradmietsystem für Sie freischalten"; } $bw->log("--->0. payable_check=$payoneable_check for $ctadr->{txt08} int01=$ctadr->{int01}|int03=$ctadr->{int03}|int04=$ctadr->{int04}|int13=$ctadr->{int13}|int12=$ctadr->{int12}|$ctadr->{ct_name}|length($ctadr->{ct_name}) >= 19\n","",""); #int04==1 if email Ack #int13==1 if sms Ack #int12!=1|2|3 if Vde #int14==1 if AGB if($ctadr->{txt08} && $ctadr->{int04} == 1 && $ctadr->{int13} == 1 && !$ctadr->{int12} && $ctadr->{int14} && $payoneable_check){ $bw->log("---> net_booking select Tarif ct->{main_id}:$ct->{main_id}| tariff_nr:$tariff_nr| ct_tariff --> Tarif-Nr:$tariff_content->{$tariff_nr}->{barcode}|Tarif desc:$tariff_content->{$tariff_nr}->{ct_name}|unit_price:$tariff_content->{$tariff_nr}->{int02}|max EUR/Tag:$tariff_content->{$tariff_nr}->{int17}|Abo EUR:$tariff_content->{$tariff_nr}->{int15}|Gratis Std/Rad:$tariff_content->{$tariff_nr}->{int16}\n","",""); $ctt = $dbt->fetch_record($dbh,$pref); #if invoice exist if($ctt->{c_id}){ my $ctpos = {}; if($bikeID && $ctadr->{c_id}){ my $booking_pos = { table => "contenttranspos", fetch => "one", barcode => "$db_bike", int10 => "IN::('2','3')", ca_id => "$ctadr->{c_id}", }; $ctpos = $dbt->fetch_tablerecord($dbh,$booking_pos); } if(!$ctpos->{c_id}){ #2 = "requested" $pos_id = $dbt->insert_pos($dbh,$ctt->{c_id},$ct,$ctadr,$tariff_content->{$tariff_nr},$now_dt,"$bikeID","2","$owner"); if($pos_id){ $response_state = "OK, bike " . $bikeID . " succesfully requested"; $response_text = "Fahrrad Nr. $bikeID wurde erfolgreich für 15 Min. reserviert"; $bw->log("--->2. (insert contenttranspos pos_id: $pos_id\n","",""); #require "Mod/KMLout.pm"; #my $kmlfile = Mod::KMLout::kmlGenerator($ctadr,""); $db->updater("contenttrans","c_id",$ctt->{c_id},"start_time","$now_dt",$owner); $db->updater("contenttrans","c_id",$ctt->{c_id},"end_time","$now_dt",$owner); }else{ $response_state="Failure 1007: booking request fails"; $response_text="Entschuldigung, es ist ein Fehler aufgetreten. Bitte kontaktieren Sie unsere Hotline damit wir das Problem lösen können"; } } #else if invoice does not exist, generate one }else{ my $ct_id; if($ctt->{c_id}){ $ct_id = $ctt->{c_id}; }else{ $ct_id = $dbt->insert_contenttrans($dbh,$ctadr,"300008","218","----","$owner"); $ctt = $dbt->fetch_record($dbh,$pref); } $ctt = $dbt->fetch_record($dbh,$pref); #TODO refactory, routines douple definend if($ctt->{c_id}){ my $ctpos = {}; if($bikeID && $ctadr->{c_id}){ my $booking_pos = { table => "contenttranspos", fetch => "one", barcode => "$db_bike", int10 => "IN::('2','3')", ca_id => "$ctadr->{c_id}", }; $ctpos = $dbt->fetch_tablerecord($dbh,$booking_pos); } if(!$ctpos->{c_id}){ #2 = "requested" $pos_id = $dbt->insert_pos($dbh,$ctt->{c_id},$ct,$ctadr,$tariff_content->{$tariff_nr},$now_dt,"$bikeID","2","$owner"); if($pos_id){ $response_state = "OK, bike " . $bikeID . " succesfully requested"; $response_text = "Fahrrad Nr. $bikeID wurde erfolgreich für 15 Min. reserviert"; $bw->log("--->3. (insert contenttranspos pos_id: $pos_id\n","",""); #require "Mod/KMLout.pm"; #my $kmlfile = Mod::KMLout::kmlGenerator($ctadr,""); $db->updater("contenttrans","c_id",$ctt->{c_id},"start_time","$now_dt",$owner); $db->updater("contenttrans","c_id",$ctt->{c_id},"end_time","$now_dt",$owner); }else{ $response_state="Failure 1008: booking request fails"; $response_text="Entschuldigung, es ist ein Fehler aufgetreten. Bitte kontaktieren Sie unsere Hotline damit wir das Problem lösen können"; } } } } }else{#end Vde AGB and payable_check $response_state="Failure 1005: user-account deactivated because of failing data"; $response_text="Bitte überprüfen Sie Ihre Profildaten auf Vollständigkeit, nur dann können wir das Fahrradmietsystem für Sie freischalten"; } }else{ my $ctpos = {}; my $booking_pos = { table => "contenttranspos", fetch => "one", barcode => "$db_bike", int10 => "IN::('2','3')", ca_id => "$ctadr->{c_id}", }; $ctpos = $dbt->fetch_tablerecord($dbh,$booking_pos) if($bikeID && $ctadr->{c_id}); if($ctpos->{c_id}){ $response_state = "OK, bike " . $bikeID . " already requested or occupied"; $response_text = "Fahrrad Nr. " . $bikeID . " ist bereits reserviert"; }elsif($ct->{c_id} && !$tariff_nr){ $response_state="Failure 2089: booking bike $bikeID fails, no user tariff available"; $response_text="Reservierungsfehler Fahrrad Nr. $bikeID. Es konnte kein Mietrad Tarif gefunden werden."; }else{ $response_state="Failure 2001: booking bike $bikeID fails, bike not available"; $response_text="Fahrrad Nr. $bikeID ist leider nicht verfügbar. U.U. ist die Fahrrad Flotte für Sie nicht freigeschaltet. Bitte überprüfen Sie Ihre Profildaten auf Vollständigkeit"; } } $bw->log("response_state:$response_state\n","",""); if(ref($auth) eq "HASH"){ $return = { bike => "$bikeID", state => "requested", response_state => "$response_state", response_text => "$response_text" }; }else{ if($response_state =~ /Failure/){ $return = "failure::int01 $response_state"; } } return $return; } #Send sms after payable check and !int13 sub smsack(){ my $self = shift; my $ctadr = shift; $smstrans->sms_ack_digest($ctadr); } #Send email after payable check and !int04 sub emailack(){ my $self = shift; my $c_id = shift; my %varenv = $cf->envonline(); system(`$varenv{basedir}/src/Mod/newsletter_tink.pl "$varenv{basedir}" "$varenv{wwwhost}" "emailack" "$c_id" ""`); } #Password forgotten send email sub send_password(){ my $self = shift; my ($email,$coo,$owner) = @_; my %varenv = $cf->envonline(); $email = $q->escapeHTML($email); $email =~ s/\s//g; my $pwmd5 = md5_hex($coo); $db->updater("contentadr","1","1","txt11","$pwmd5","$owner","txt08","ilike","$email"); $bw->log("$varenv{basedir}/src/Mod/newsletter_tink.pl",$email,""); system(`$varenv{basedir}/src/Mod/newsletter_tink.pl "$varenv{basedir}" "$varenv{wwwhost}" "send_password" "$email" "$coo"`); } 1;