2021-12-30 12:05:56 +01:00
package Prelib ;
#
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
#migrate some methodes form Prelogic and Premain to here
#defined methodes are available for web-app and backend
use strict ;
use warnings ;
use POSIX ;
use File::Path qw( make_path remove_tree ) ;
use CGI ':standard' ;
use CGI::Carp qw( fatalsToBrowser ) ;
use Scalar::Util qw( looks_like_number ) ;
use Lib::Config ;
use Mod::Libenzdb ;
use Mod::Libenz ;
use Mod::DBtank ;
use Mod::Basework ;
use Mod::APIfunc ;
use Data::Dumper ;
my $ cf = new Config ;
my $ db = new Libenzdb ;
my $ lb = new Libenz ;
my $ dbt = new DBtank ;
my $ bw = new Basework ;
my $ apif = new APIfunc ;
my $ q = new CGI ;
my @ keywords = $ q - > param ;
sub new {
my $ class = shift ;
my $ self = { } ;
bless ( $ self , $ class ) ;
return $ self ;
}
my $ i_rows = 0 ;
my $ u_rows = 0 ;
my $ d_rows = 0 ;
my $ lang = "de" ;
my % varenv = $ cf - > envonline ( ) ;
my $ now_dt = strftime "%Y-%m-%d %H:%M:%S" , localtime ;
my $ debug = 1 ;
#new node relation with option to create subnode for Servicelog
sub new_relation {
my $ self = shift ;
my $ main_id = shift ;
my $ owner = shift ;
my % varenv = $ cf - > envonline ( ) ;
my $ ret = "" ;
my $ dbh = "" ;
#$ret = "failure::temporarily disabled";
#return $ret;
open ( FILE , ">>$varenv{logdir}/new_relation.log" ) if ( $ debug ) ;
print FILE "\n*--> $now_dt| main_id: $main_id | owner: $owner\n" if ( $ debug ) ;
my $ prefix_id = "0" ;
my $ working_parent_id = $ R:: parent_id ;
$ prefix_id = $ 1 if ( $ R:: main_id =~ /^(\d)/ && $ R:: main_id >= "100000" ) ;
$ ret = $ lb - > checkinput ( $ R:: node_name ) ;
return $ ret if ( $ ret =~ /failure/ ) ;
my $ node_name = $ q - > escapeHTML ( $ R:: node_name ) ;
#check multiple node_name
my $ subrelnode = $ dbt - > get_subrelnode ( $ dbh , $ working_parent_id , "" , $ node_name ) ;
if ( $ subrelnode - > { node_name } eq "$R::node_name" ) {
return "failure::Abbruch, der Menuename \"$subrelnode->{node_name}\" ist bereits vorhanden. Bitte eindeutige Menuenamen verwenden." ;
}
if ( $ R:: new_submenu ) {
$ working_parent_id = $ R:: main_id ;
$ prefix_id + + ;
}
my $ new_main_id = $ dbt - > get_freenode ( $ dbh , $ prefix_id ) ;
my $ template_id = 0 ,
my $ n_sort = 1 ;
$ template_id = $ R:: template_id if ( looks_like_number ( $ R:: template_id ) ) ;
$ n_sort = $ R:: n_sort if ( looks_like_number ( $ R:: n_sort ) ) ;
my $ insert = {
main_id = > $ new_main_id ,
parent_id = > $ working_parent_id ,
template_id = > $ template_id ,
content_id = > 0 ,
node_name = > $ node_name ,
n_sort = > $ n_sort ,
lang = > "de" ,
owner = > $ owner ,
change = > "now()" ,
} ;
my $ rel_id = $ dbt - > insert_nodeoid ( $ dbh , $ insert ) ;
$ i_rows = 1 if ( $ rel_id > 0 ) ;
print FILE "new_relation with" . Dumper ( $ insert ) . "\n" if ( $ debug ) ;
#sub Servicelog for rental bikes
if ( $ template_id == 205 ) {
$ prefix_id + + ;
my $ new_submain_id = $ dbt - > get_freenode ( $ dbh , $ prefix_id ) ;
my $ new_subtemplate_id = $ dbt - > get_freetpl ( $ dbh , "400" , "499" ) ;
my $ ret_tpl_id = $ dbt - > copy_template ( $ dbh , "400" , $ new_subtemplate_id , $ owner ) ;
my $ insert_sub = {
main_id = > $ new_submain_id ,
parent_id = > $ new_main_id ,
template_id = > $ new_subtemplate_id ,
content_id = > 0 ,
node_name = > "$node_name-Servicelog" ,
n_sort = > $ n_sort ,
lang = > "de" ,
owner = > $ owner ,
change = > "now()" ,
} ;
my $ subrel_id = $ dbt - > insert_nodeoid ( $ dbh , $ insert_sub ) ;
$ i_rows += 1 if ( $ subrel_id > 0 ) ;
print FILE "new_subrelation with" . Dumper ( $ insert_sub ) . "\nwith template_id=$ret_tpl_id" if ( $ debug ) ;
}
close ( FILE ) if ( $ debug ) ;
my $ uri_path = $ dbt - > recurse_node ( "" , $ new_main_id ) ;
print "$varenv{wwwhost}/$uri_path?return=$i_rows-$u_rows-$d_rows\n" ;
print redirect ( "$varenv{wwwhost}/$uri_path?return=$i_rows-$u_rows-$d_rows" ) ;
exit 0 ;
}
#end new_relation
#save node relation
sub save_relation {
my $ self = shift ;
my $ main_id = shift ;
my $ owner = shift ;
my % varenv = $ cf - > envonline ( ) ;
my $ dbh = "" ;
my $ update_node = {
table = > "nodes" ,
main_id = > "$main_id" ,
} ;
my $ update_relation = {
table = > "relation" ,
main_id = > "$main_id" ,
} ;
my $ subrelnode = $ dbt - > get_subrelnode ( $ dbh , $ main_id , "" , "" ) ;
foreach ( @ keywords ) {
my $ val = $ q - > param ( $ _ ) ;
my $ valxx = $ q - > escapeHTML ( "$val" ) ;
$ valxx =~ s/^\s+// ; $ valxx =~ s/\s+$// ;
if ( ( $ _ eq "node_name" ) && $ valxx ) {
#if defined another path
my $ node_name = $ valxx ;
my $ node_path = $ node_name ;
#internal for splitting node_name node_path
( $ node_name , $ node_path ) = split ( /\|/ , $ node_name ) if ( $ node_name =~ /\|/ ) ;
my $ return ;
$ return = $ lb - > checkinput ( $ node_name ) ;
$ return = $ lb - > checkinput ( $ node_path ) ;
return $ return if ( $ return =~ /failure/ ) ;
$ u_rows = $ dbt - > update_one ( $ dbh , $ update_node , "node_name='$node_name'" ) ;
$ u_rows = $ dbt - > update_one ( $ dbh , $ update_node , "node_path='$node_path'" ) ;
if ( $ subrelnode - > { main_id } && $ subrelnode - > { template_id } >= 400 && $ subrelnode - > { template_id } <= 499 ) {
my $ update_subnode = {
table = > "nodes" ,
main_id = > "$subrelnode->{main_id}" ,
} ;
$ u_rows = $ dbt - > update_one ( $ dbh , $ update_subnode , "node_name='$node_name-Servicelog'" ) ;
$ u_rows = $ dbt - > update_one ( $ dbh , $ update_subnode , "node_path='$node_path-Servicelog'" ) ;
}
}
if ( $ _ =~ /template_id/ && $ valxx ) {
$ u_rows = $ dbt - > update_one ( $ dbh , $ update_relation , "template_id=$valxx" ) ;
}
if ( $ _ =~ /int|n_sort|owner|node_public/ ) {
$ valxx =~ s/,/./ ;
$ valxx = "null" if ( ! $ valxx && $ valxx ne "0" ) ; #for empty
$ valxx = "0" if ( $ valxx eq "0" ) ;
$ u_rows = $ dbt - > update_one ( $ dbh , $ update_node , "$_=$valxx" ) if ( $ valxx =~ /^\d+$|null|0/ ) ;
}
if ( $ _ =~ /txt01/ ) {
$ u_rows = $ dbt - > update_one ( $ dbh , $ update_node , "$_='$valxx'" ) ;
}
if ( ! - d "$varenv{data}/$main_id" ) {
mkdir ( "$varenv{data}/$main_id" , 0777 ) ;
mkdir ( "$varenv{data}/$main_id-thumb" , 0777 ) ;
mkdir ( "$varenv{data}/$main_id-resize" , 0777 ) ;
}
}
my $ uri_path = $ dbt - > recurse_node ( "" , $ main_id ) ;
print "$varenv{wwwhost}/$uri_path?return=$i_rows-$u_rows-$d_rows\n" ;
print redirect ( "$varenv{wwwhost}/$uri_path?return=$i_rows-$u_rows-$d_rows" ) ;
exit 0 ;
}
#delete node relation with some ki deleting sub content
sub delete_relation {
my $ self = shift ;
my $ main_id = shift ;
my $ owner = shift ;
my % varenv = $ cf - > envonline ( ) ;
my $ dbh = "" ;
my $ ret = "" ;
my $ debug = 1 ;
open ( FILE , ">>$varenv{logdir}/delete_relation.log" ) if ( $ debug ) ;
print FILE "\n*--> $now_dt| main_id: $main_id \n" if ( $ debug ) ;
#get all node para
my $ noderef = {
main_id = > $ main_id ,
fetch = > "one" ,
} ;
my $ noderel = $ dbt - > fetch_rel4tpl4nd ( $ dbh , $ noderef ) ;
my $ ctref = {
table = > "$noderel->{ct_table}" ,
main_id = > $ main_id ,
fetch = > "one" ,
c_id = > ">::0" ,
} ;
my $ ct_record = $ dbt - > fetch_record ( $ dbh , $ ctref ) ;
my $ collect_rows = 0 ;
if ( $ R:: template_id eq "205" ) {
( my $ collect_node , $ collect_rows ) = $ dbt - > collect_noderel ( $ dbh , $ noderel - > { parent_id } , $ R:: template_id ) ;
}
my $ subrelnode = $ dbt - > get_subrelnode ( $ dbh , $ main_id , "" , "" ) ;
#if 1 then deleteable
my $ deleteable_subnode = 1 ;
my $ deleteable_node = 1 ;
my $ deleteable_last_node = 1 ;
if ( $ subrelnode - > { template_id } >= 400 && $ subrelnode - > { template_id } <= 499 ) {
$ deleteable_subnode = 1 ;
if ( $ collect_rows <= 1 ) {
$ deleteable_last_node = 0 ;
}
} elsif ( $ subrelnode - > { template_id } ) {
$ deleteable_subnode = 0 ;
}
if ( $ ct_record - > { c_id } > 0 ) {
$ deleteable_node = 0 ;
}
print FILE "$deleteable_subnode == 0 || $deleteable_node == 0 --> collect_rows: $collect_rows|c_id: $ct_record->{c_id}\n" if ( $ debug ) ;
if ( $ deleteable_last_node == 0 ) {
$ ret = "failure::Abbruch, es muss mindestens eine Mietrad Flotte definiert sein. ($collect_rows on $noderel->{parent_id})" ;
} elsif ( $ deleteable_subnode == 0 || $ deleteable_node == 0 ) {
$ ret = "failure::Abbruch, der Ordner enthält Daten. Für die referentielle Integrität ist es notwendig die Ordner Inhalte (content) und/oder Relationen des Ordners zu löschen. ($deleteable_subnode == 0 || $deleteable_node == 0 , $subrelnode->{template_id}, $main_id, $ct_record->{c_id}, $noderel->{ct_table})" ;
} else {
print FILE "delete_relation with $subrelnode->{main_id}, $subrelnode->{template_id}\n" if ( $ debug ) ;
if ( $ deleteable_subnode && $ subrelnode - > { main_id } ) {
$ dbt - > delete_content ( $ dbh , "contentpos" , "all" , $ subrelnode - > { template_id } ) if ( $ subrelnode - > { template_id } >= 400 && $ subrelnode - > { template_id } <= 499 ) ;
$ d_rows += $ dbt - > delete_noderel ( $ dbh , $ subrelnode - > { main_id } ) ;
$ d_rows += $ dbt - > delete_template ( $ dbh , $ subrelnode - > { template_id } ) ;
}
$ d_rows += $ dbt - > delete_noderel ( $ dbh , $ main_id ) ;
remove_tree ( "$varenv{data}/$main_id" ) ;
remove_tree ( "$varenv{data}/$main_id-thumb" ) ;
remove_tree ( "$varenv{data}/$main_id-resize" ) ;
my $ uri_path = $ dbt - > recurse_node ( $ dbh , $ noderel - > { parent_id } ) ;
$ uri_path =~ s/\/\w+$// ;
print redirect ( "$varenv{wwwhost}/$uri_path?return=$i_rows-$u_rows-$d_rows" ) ;
exit 0 ;
}
close ( FILE ) if ( $ debug ) ;
return $ ret ;
}
#sharee Bonusnummer with Tarif automatic
sub set_usertarif {
my $ self = shift ;
my $ dbh = shift ;
my $ dbname = shift ;
my $ adr_bonus = shift ;
2022-01-16 12:17:11 +01:00
my $ bonus_collect = shift || { } ;
2021-12-30 12:05:56 +01:00
open ( FILE , ">>$varenv{logdir}/save_account.log" ) if ( $ debug ) ;
print FILE "\n*Prelib--> $now_dt| c_id: $adr_bonus->{c_id} \n" if ( $ debug ) ;
my $ ret = $ adr_bonus - > { ret } ;
my $ i = 0 ;
my $ dbh_operator = $ dbt - > dbconnect_extern ( $ dbname ) ; #operator connect
if ( $ adr_bonus - > { txt15 } =~ /\w+/ ) {
if ( 1 == 1 ) {
2022-01-16 12:17:11 +01:00
my @ new_txt30 = ( ) ;
#collect multiple tarif by bonusnr
2021-12-30 12:05:56 +01:00
my $ pref_cc = {
table = > "content" ,
keyfield = > "c_id" ,
fetch = > "all" ,
template_id = > "228" ,
int03 = > ">::0" ,
ct_name = > $ adr_bonus - > { txt15 } ,
} ;
2022-01-16 12:17:11 +01:00
$ bonus_collect = $ dbt - > fetch_record ( $ dbh_operator , $ pref_cc ) if ( ref ( $ bonus_collect - > { 1 } ) ne "HASH" ) ;
#print FILE "Prelib bonus_collect:\n" . Dumper($bonus_collect) . "\n";
foreach my $ id ( keys ( %$ bonus_collect ) ) {
2021-12-30 12:05:56 +01:00
print FILE "-1-> txt15: $adr_bonus->{txt15}\n" if ( $ debug ) ;
$ i + + ;
foreach my $ sourcetarif ( @ { $ adr_bonus - > { txt30_array } } ) {
2022-01-16 12:17:11 +01:00
print FILE "-1.2-> activeTarif-source:$sourcetarif | Bonus-source:$bonus_collect->{$id}->{int21} | Bonus-target:$bonus_collect->{$id}->{int22}\n" if ( $ debug ) ;
if ( $ sourcetarif eq $ bonus_collect - > { $ id } - > { int22 } ) {
print FILE "-2.1-> still activ Bonusnr ct_name: $bonus_collect->{$id}->{ct_name}\n" if ( $ debug ) ;
2021-12-30 12:05:56 +01:00
$ ret = "success::txt15" ;
2022-01-16 12:17:11 +01:00
#push(@new_txt30,$sourcetarif);
} elsif ( $ bonus_collect - > { $ id } - > { int21 } eq $ sourcetarif && $ bonus_collect - > { $ id } - > { int22 } ) {
if ( $ id > 3 ) { #means if not file greped with static c_id <= 3
$ dbt - > update_content4comp ( $ dbh_operator , $ bonus_collect - > { $ id } - > { c_id } , "-" , "1" ) ;
}
2021-12-30 12:05:56 +01:00
$ u_rows = $ dbt - > update_one ( $ dbh_operator , $ adr_bonus , "txt15='$adr_bonus->{txt15}'" ) ;
2022-01-16 12:17:11 +01:00
print FILE "-2.2-> match-update Bonusnr ct_name: $bonus_collect->{$id}->{ct_name}\n" if ( $ debug ) ;
2021-12-30 12:05:56 +01:00
$ ret = "success::txt15" ;
2022-01-16 12:17:11 +01:00
push ( @ new_txt30 , $ bonus_collect - > { $ id } - > { int22 } ) ;
2021-12-30 12:05:56 +01:00
} else {
2022-01-16 12:17:11 +01:00
print FILE "-2.3-> No matching Bonusnr ct_name: $bonus_collect->{$id}->{ct_name}, keeping sourcetarif\n" if ( $ debug ) ;
2021-12-30 12:05:56 +01:00
push ( @ new_txt30 , $ sourcetarif ) ;
#$ret = "failure::txt15#top1";
}
}
}
if ( @ new_txt30 ) {
print FILE "-3-> txt30: @new_txt30\n" if ( $ debug ) ;
$ u_rows = $ dbt - > update_one ( $ dbh_operator , $ adr_bonus , "txt30='@new_txt30'" ) ;
2022-01-16 12:17:11 +01:00
$ u_rows = $ dbt - > update_one ( $ dbh_operator , $ adr_bonus , "txt15='$adr_bonus->{txt15}'" ) ;
2021-12-30 12:05:56 +01:00
}
$ 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=''" ) ;
$ 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 ;
}
1 ;