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

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;

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;


#set Faktura workflow like Rechnung to Storno
sub set_workflow {
 my $self = shift;
 my $users_dms = shift;
 my $c_id = shift;
 my $set_main_id = shift || "";
 my %varenv = $cf->envonline();
 my $dbh = "";
 my $node = $dbt->get_node($dbh,$set_main_id);

 my $pref = {
     table  => "contenttrans",
     fetch  => "one",
     c_id   => $c_id,
  };

  my $ctt = { c_id => 0 };
  $ctt = $dbt->fetch_tablerecord($dbh,$pref);

  #barcode setting logic reset. keep barcode from orignal for backlinking
  #counter invoice subnr
  if($ctt->{ct_name} =~ /\d+-\d+/){
        my ($ct_name,$subname) = split(/-/,$ctt->{ct_name});
        $subname++;
        $ctt->{ct_name} = "$ct_name-$subname";
  }else{
        $ctt->{ct_name} = "$ctt->{ct_name}-1";
  }
  delete $ctt->{c_id}; 
  delete $ctt->{txt00}; 
  delete $ctt->{state}; 
  delete $ctt->{int01};
  delete $ctt->{int14};
  delete $ctt->{int15};
  delete $ctt->{int16};
  delete $ctt->{int18};
  delete $ctt->{txt16};
  delete $ctt->{txt12};
  delete $ctt->{txt21};
  delete $ctt->{txt22};
  delete $ctt->{txt23};
  delete $ctt->{txt25};
  delete $ctt->{txt30};
  delete $ctt->{itime}; 
  delete $ctt->{mtime}; 
  delete $ctt->{close_time}; 
  delete $ctt->{invoice_time};
  delete $ctt->{pay_time};

  my $insert_ctt = {
      %$ctt,
      table   => "contenttrans",
      itime   => 'now()',
      mtime   => 'now()',
      owner   => "$users_dms->{u_id}",
      ct_name => "$ctt->{ct_name}",
      txt00 => "$node->{node_name}",
      template_id => "218",
      main_id => "$node->{main_id}",
      };
   my $c_idnew = 0;
   $c_idnew = $dbt->insert_contentoid($dbh,$insert_ctt,"");
   $i_rows = 1 if($c_idnew);
   #print Dumper($insert_ctt);
   #exit;

   #position copy
   if($c_idnew > 0){
     my ($cttpos,$rows) = $db->collect_contentpos("contenttrans",$c_id);
     foreach my $id (sort { lc($cttpos->{$a}->{sort}) cmp lc($cttpos->{$b}->{sort}) } keys(%$cttpos)){
       $cttpos->{$id}->{int02} = $cttpos->{$id}->{int02} * -1 if($cttpos->{$id}->{int02} != 0);
       $cttpos->{$id}->{int07} = $cttpos->{$id}->{int07} * -1 if($cttpos->{$id}->{int07} != 0 && $cttpos->{$id}->{int08} == 1);#if Rabatt int08 != 1 alias €;

       delete $cttpos->{$id}->{c_id};
       delete $cttpos->{$id}->{ct_id};
       delete $cttpos->{$id}->{itime};
       delete $cttpos->{$id}->{mtime};
       my $insert_pos = {
                %{$cttpos->{$id}},
                table   => "contenttranspos",
                ct_id   => $c_idnew,
                itime   => 'now()',
                mtime   => 'now()',
       };
        my $ctpos_id = $dbt->insert_contentoid($dbh,$insert_pos,"");
        $i_rows += 1 if($ctpos_id > 0);

     }
   }
   $db->update_users4trans($c_idnew,"218","",$users_dms->{u_id});

   my $uri_path = $dbt->recurse_node("",$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;
}#end set_workflow

#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,"401","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 @keywords = $q->param;
 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($noderel->{template_id} == 205){
   (my $collect_node,$collect_rows) = $dbt->collect_noderel($dbh,$noderel->{parent_id},$noderel->{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;
 #TODO, $subrelnode->{template_id} must be unique in Flotte context
 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 "$deleteable_subnode|$deleteable_node|$deleteable_last_node|$collect_rows";

 print FILE "deleteable_subnode:$deleteable_subnode | deleteable_node:$deleteable_node | deleteable_last_node:$deleteable_last_node --> 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;
 my $bonus_collect = shift || {};

 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){
     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 => $adr_bonus->{txt15},
       };
     $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)){
       print FILE "-1-> txt15: $adr_bonus->{txt15}\n" if($debug);
       $i++;
       foreach my $sourcetarif (@{$adr_bonus->{txt30_array}}){
         print FILE "-1.2-> activeTarif:$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);
       	   $u_rows = $dbt->update_one($dbh_operator,$adr_bonus,"txt15='$adr_bonus->{txt15}'");
	   $ret = "success::txt15";
           push(@new_txt30,$bonus_collect->{$id}->{int22});
	   #push(@new_txt30,$sourcetarif);
	 }elsif($sourcetarif eq $bonus_collect->{$id}->{int21} && $bonus_collect->{$id}->{int22}){
       	   print FILE "-2.2-> match-update Bonusnr ct_name: $bonus_collect->{$id}->{ct_name}\n" if($debug);
	   if($id > 3){#means if not file greped with static c_id <= 3
	     $dbt->update_content4comp($dbh_operator,$bonus_collect->{$id}->{c_id},"-","1");
	   }
	   $u_rows = $dbt->update_one($dbh_operator,$adr_bonus,"txt15='$adr_bonus->{txt15}'");
	   $ret = "success::txt15";
           push(@new_txt30,$bonus_collect->{$id}->{int22});
         }else{
	   #if no matching Bonusnr then keep sourcetarif
       	   print FILE "-2.3-> No matching Bonusnr ct_name: $bonus_collect->{$id}->{ct_name}, doing nothing and keep sourcetarif\n" if($debug);
	   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'");
     }
     $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;
}

#save service-config
sub save_service_desc {
  my $self = shift;
  my $c_id = shift;
  my $users_dms = shift;
  my @keywords = $q->param;
  my $dbh = "";
  my $c_tplid = {c_id => $c_id};
  my $update_ctuser = {
          table   => "contentuser",
          template_id => "199",
          mtime => "now()",
          owner => "$users_dms->{u_id}",
  };

  my $update_template = {
          table   => "template",
          tpl_id => "$c_id",
          owner => "$users_dms->{u_id}",
  };

  open(FILE,">>$varenv{logdir}/save_service_desc.log") if($debug);
  print FILE "\n*Prelib--> $now_dt | ctpl_id $c_id | owner: $users_dms->{u_id}\n" if($debug);

  my $tpl_order_desc = "c_id=ID=4=0=0,mtime=Zeitstempel=6=0=0,owner=von=3=0=0,barcode=Rad=3=0=0,txt01=Aufgaben=area5-8=0=0";
  foreach(@keywords){
   my @val = $q->param($_);
   my $valxx = $q->escapeHTML("@val");
   $valxx =~ s/\s/=/g;
   print FILE $_ . ":" . $valxx . "<br>\n";

   my $count = 0;
   ++$count while $valxx =~ /=/g;
   return "failure::Abbruch. Die Wartungsnamen dienen als Schlüsselwerte und dürfen somit keine Leer- oder Sonderzeichen enthalten ($valxx). Das Speichern wurde abgebrochen!" if($count > 4);

   #txt01:int01=Reifen-Bremse-Lampe=checkbox=10=2
   if($_ =~ /txt\d+/ && $valxx =~ /int\d+=[a-z-]+=checkbox=\d+=\d/i){
	$update_ctuser->{$_} = "$valxx";
	$tpl_order_desc .= ",$valxx";
   }
  }
  print FILE "update contentuser c_id:$c_id\n" . Dumper($update_ctuser) . "\n";
  print FILE "update template tpl_id:$c_id\n" . $tpl_order_desc . "\n";

  my $rows = 0;
  $rows = $dbt->update_record($dbh,$update_ctuser,$c_tplid);
  $rows = $dbt->update_one($dbh,$update_template,"tpl_order='$tpl_order_desc'");

  close(FILE) if($debug);
  return $rows;
}

1;