package Libenz; # #Deprecated module, better use Prelib.pm or Basework.pm # # SPDX-License-Identifier: AGPL-3.0-or-later # Copyright (c) Rainer Gümpelein, TeilRad GmbH # use strict; use warnings; use POSIX; use File::Path qw(make_path remove_tree); use File::Copy; use File::Copy::Recursive qw(fcopy rcopy dircopy fmove rmove dirmove); use Getopt::Long; use CGI; # only for debugging use CGI::Carp qw(fatalsToBrowser); use Calendar::Simple; use Date::Calc qw(:all); use Mod::Callib; use Mod::Libenzdb; use Mod::Buttons; use Lib::Config; use Digest::MD5 qw(md5 md5_hex); use Scalar::Util qw(looks_like_number); my $cf = new Config; my $cb = new Callib; my $but = new Buttons; my $db = new Libenzdb; my $q = new CGI; #my $pi = new Image::Magick; $q->import_names('R'); sub new { my $class = shift; my $self = {}; bless($self,$class); return $self; } my %varenv = $cf->envonline(); my $lang="de"; my $now_time = strftime "%Y-%m-%d %H:%M", localtime; my @months = $cb->monthmap(); my @days = $cb->daymap(); my $i_rows=0; my $u_rows=0; my $d_rows=0; my $nall; sub grep_filecontent(){ my $self = shift; my ($filename,$content,$pattern) = @_; my $match = ""; if (open(my $fh, '<:encoding(UTF-8)', $filename)) { while (my $row = <$fh>) { $row =~ s/\n//; $row =~ s/\r//; if($content && $row eq $content){ $match = $content; }elsif($pattern && $row =~ /$pattern/){ $match = $row; } } } return $match; } # calculates the distance between two latitude, longitude points sub geo_fencing { my $self = shift; my ($lat1, $lon1, $lat2, $lon2) = @_; my $pi = atan2(1,1) * 4; if (($lat1 == $lat2) && ($lon1 == $lon2)) { return 0; } else { my $theta = $lon1 - $lon2; my $dist = sin($lat1 * $pi / 180) * sin($lat2 * $pi / 180) + cos($lat1 * $pi / 180) * cos($lat2 * $pi / 180) * cos($theta * $pi / 180); $dist = atan2(sqrt(1 - $dist**2), $dist); $dist = $dist * 180 / $pi; $dist = $dist * 60 * 1.1515;#Miles $dist = $dist * 1.609344 * 1000;#Meters $dist = sprintf('%.0f',$dist); return ($dist); } } sub country_code(){ my $self = shift; my $country = { 'DE' => 'Deutschland', 'BE' => 'Belgien', 'BG' => 'Bulgarien', 'CH' => 'Schweiz', 'CZ' => 'Tschechische Republik', 'DK' => 'Dänemark', 'EE' => 'Estland', 'IE' => 'Irland', 'EL' => 'Griechenland', 'ES' => 'Spanien', 'FR' => 'Frankreich', 'HR' => 'Kroatien', 'IT' => 'Italien', 'CY' => 'Zypern', 'LV' => 'Lettland', 'LT' => 'Litauen', 'LU' => 'Luxemburg', 'HU' => 'Ungarn', 'MT' => 'Malta', 'NL' => 'Niederlande', 'AT' => 'Österreich', 'PL' => 'Polen', 'PT' => 'Portugal', 'RO' => 'Rumänien', 'SI' => 'Slowenien', 'SK' => 'Slowakei', 'FI' => 'Finnland', 'SE' => 'Schweden', 'GB' => 'Vereinigtes Königreich' }; return $country; } #read directory sub read_dirfiles(){ my $self = shift; my ($dir,$extensions,$dirOfile,$not) = @_; my @dirfiles; if( -d "$dir" || -l "$dir"){ opendir(DIR, "$dir") or die "could not open $dir $!"; foreach(sort(readdir(DIR))){ if($dir =~ /INBOX/){ if($_ =~ /^$extensions/){ push(@dirfiles,$_) if(-f "$dir/$_" && $dirOfile eq "file"); push(@dirfiles,$_) if(-d "$dir/$_" && $dirOfile eq "dir"); } } elsif($not){ if(uc($_) !~ /$extensions/){ push(@dirfiles,$_) if(-f "$dir/$_" && $dirOfile eq "file"); push(@dirfiles,$_) if(-d "$dir/$_" && $dirOfile eq "dir"); } }else{ if(uc($_) =~ /$extensions/ || $_ =~ /$extensions/){ push(@dirfiles,$_) if(-f "$dir/$_" && $dirOfile eq "file"); push(@dirfiles,$_) if(-d "$dir/$_" && $dirOfile eq "dir"); } } } closedir DIR; }else{ print "\ndirectory: $dir does not exist\n $!\n"; } return @dirfiles; } #return message sub return_feedback(){ my $self = shift; my ($return,$kind_of_trans,$owner,$terminal) = @_; if($owner > 0){ print< \$(document).ready(function(){ \$( "#retm" ).fadeOut(7000); }) EOF ; $return = $R::return if($R::return); my ($ret_pm,$ret_pl,$ret_er) = split(/\|/,$return); my ($i_pm,$s_pm,$d_pm) = split(/-/,$ret_pm); my ($i_pl,$s_pl,$d_pl) = split(/-/,$ret_pl); my $pre = ""; $kind_of_trans = "Transaktions" if(!$kind_of_trans); my $feedb = ""; $feedb = "neue $pre Daten eingefügt" if($i_pm); $feedb = "insert successfully " if($i_pm && $varenv{html_lang} eq "en"); $feedb = "$pre Daten gespeichert" if($s_pm); $feedb = "saved successfully" if($s_pm && $varenv{html_lang} eq "en"); $feedb = "$pre Daten gelöscht" if($d_pm); $feedb = "deleted successfully" if($d_pm && $varenv{html_lang} eq "en"); $feedb = "neue $kind_of_trans Daten eingefügt" if($i_pl); $feedb = "$kind_of_trans Daten gespeichert" if($s_pl); $feedb = "$kind_of_trans Daten gelöscht" if($d_pl); $feedb = "Artikel eingefügt" if($i_pl =~ /ctpos_id=\d+/); my $debug; $debug = "($ret_pm|$ret_pl)" if($owner eq "101"); if($return !~ /failure/ && $feedb){ print $q->div({-id=>'retm'},"$feedb $debug"),"\n"; } } $return = $1 if($return =~ /(failure.*)/); return $return; } #Quersumme sub quersum(){ my $self = shift; my ($kecks) = @_; my $laenge = length($kecks); my $quersum = 0; for(my $i=0; $i<$laenge; $i++) { my $signs = substr($kecks, $i, 1); $quersum = $quersum + int(ord($signs)); } return $quersum; } #Calfkt to get a scalable line of days per month sub month_line(){ my $self = shift; my ($users) = @_; #my $users = $db->select_users($u_id); my $hh;my $mm; my $day = strftime "%d", localtime; my $mon = strftime "%m", localtime; my $year = strftime "%Y", localtime; my $day_today = $day; my $mon_today = $mon; my $year_today = $year; ($year,$mon,$day,$hh,$mm) = &split_date("",$users->{cal_start}) if($users->{cal_start}); #print "$year,$mon,$day,$hh,$mm"; my $month_days = Days_in_Month($year,$mon); my $factor = 100 / $month_days; $factor = sprintf('%.3f',$factor); my @month = calendar($mon, $year); my $raster_mmpx = $factor . "%"; #bsp.: 100% / 31days my $day4month; my $bg; my @week; my $i=0; my $j=0; #month, week loop foreach (@month) { $i=0; $j++; #print map { $_ ? sprintf "%2d ", $_ : '  x  ' } @$_; #day-of-week loop foreach(@$_){ if($_){ $_ = "0$_" if($_ < "10"); $week[$j] .= "$_,"; #print $q->th({-nowrap=>1},"$days[$i] $_"); if("$_" eq "$day_today" && "$mon" eq "$mon_today"){ $bg="#009899"; }else{ $bg="silver"; } $day4month .= "
|$days[$i] $_
\n"; } $i++; } } my $daymarker = $raster_mmpx * ($day_today - 0.5); #my $daymarker = $raster_mmpx * $day_today; $daymarker .= "%"; return ($daymarker,$raster_mmpx,$day4month); } #rent scale sub rent_scale(){ my $self = shift; my ($users,$year_st,$mon_st,$day_st,$hh_st,$mm_st,$year_en,$mon_en,$day_en,$hh_en,$mm_en) = @_; #print "
($u_id,$year_st,$mon_st,$day_st,$hh_st,$mm_st,$year_en,$mon_en,$day_en,$hh_en,$mm_en)
"; #my $users = $db->select_users($u_id); my $hh;my $mm; my $day = strftime "%d", localtime; my $mon = strftime "%m", localtime; my $year = strftime "%Y", localtime; ($year,$mon,$day,$hh,$mm) = &split_date("",$users->{cal_start}) if($users->{cal_start}); my $month_days = Days_in_Month($year,$mon); my $factor = 100 / $month_days; my @month = calendar($mon, $year); my $doy_mon_st=0;my $doy_mon_en=0;my $doy_st=0;my $doy_en=0; my $day_stpx = 0; my $rent_day_px = 0; if(looks_like_number($year_st) && looks_like_number($mon_st) && looks_like_number($day_st) && looks_like_number($year_en) && looks_like_number($mon_en) && looks_like_number($day_en)){ #print "if(($year == $year_st) && ($mon == $mon_st)){
"; if(($year == $year_st) && ($mon == $mon_st)){ $doy_mon_st = Day_of_Year($year_st,$mon_st,1);#JahresTage bis Monatsanfang $doy_st = Day_of_Year($year_st,$mon_st,$day_st); }else{ $doy_mon_st = Day_of_Year($year,$mon,1); $doy_st = Day_of_Year($year,$mon,1); } if(($year == $year_en) && ($mon == $mon_en)){ $doy_en = Day_of_Year($year_en,$mon_en,$day_en); #}elsif($year_en && $mon_en){ #my $month_days_en = Days_in_Month($year_en,$mon_en); #$doy_en = Day_of_Year($year_en,$mon_en,$month_days_en); }elsif($year && $mon){ my $month_days_en = Days_in_Month($year,$mon); $doy_en = Day_of_Year($year,$mon,$month_days_en);# wenn ausserhalb --> cal_start } if(($mon != $mon_en) && ($mon != $mon_st)){ $doy_mon_st=0;$doy_mon_en=0;$doy_st=0;$doy_en=0; } my $day_st_new = $doy_st - $doy_mon_st; #print "
$day_st_new = $doy_st - $doy_mon_st|"; #day rent-duration my $rent_day = ($doy_en - $doy_st + 1); #print "$rent_day = ($doy_en - $doy_st + 1)
"; #$rent_day_px = $rent_day * $multi if($doy_en && $doy_st); #$rent_day_px .= "px"; $rent_day_px = $rent_day * $factor if($doy_en && $doy_st); $rent_day_px .= "%"; #debug #print "$ct_n --- start: $day_st_new = $doy_st - $doy_mon_st | länge: $rent_day = $doy_en - $doy_st |
"; #start day align left #$day_stpx = ($day_st_new + 0) * $multi if($day_st_new); #$day_stpx .= "px"; $day_stpx = $day_st_new * $factor; $day_stpx .= "%"; } #print "$day_stpx,$rent_day_px
"; return ($day_stpx,$rent_day_px); } #check if barcodeable sub barcodeable(){ my $self = shift; my ($table,$number) = @_; my $oGdBar = GD::Barcode->new("Code39", "$number"); my $ct_name = $oGdBar->{text}; my $barcode = $oGdBar->{text}; return ($ct_name,$barcode); } #TODO or change to barcode=c_id #get free barcode sub get_freenr(){ my $self = shift; my ($table,$barcode_last) = @_; my $freenr = $db->collect_content3($table); my $s_id = $barcode_last; my $e_id = "100000"; $freenr->{$s_id}->{barcode} = "1000" if(!$freenr->{$s_id}->{barcode} || $freenr->{$s_id}->{barcode} == 0); for (; $s_id < $e_id; $s_id++){ if($freenr->{$s_id}->{barcode} != $s_id){ return $s_id; } } } #umst breaking date 16 19 % sub umst_breaking(){ my $self = shift; my $ctt = shift; my $now_dt = shift || "";#used by payone_cron.pl, because there is no mtime-update on start #invoice_time will be set by Printpreview.pm invoice generation! my $i_datetime = $now_dt || $ctt->{invoice_time} || $ctt->{mtime}; my $umst1619 = 19; my ($i_date,$i_time) = split(/ /,$i_datetime); my ($yy,$mo,$dd) = split(/-/,$i_date); my $breaking_date = $yy . $mo . $dd; $umst1619 = 16 if($breaking_date >= 20200701 && $breaking_date < 20210101); return $umst1619; } #integer check sub checkint(){ my $self = shift; my ($int) = @_; $int =~ s/,/./; if($int =~ /([-\d]+)\.(\d+)/){ $int = "$1" . "." . "$2"; }elsif($int =~ /([-\d]+)/){ $int = "$1"; } return $int; } # input character check sub checkinput(){ my $self = shift; my $node_name = shift; if($node_name =~ /^[a-zA-Z0-9äöüÄÖÜ_\-\.\ ]+$/){ return 0; }else{ return "failure::Für die Menue- Ordner Benennung sind nur alphanumerische Zeichen und - . erlaubt ($node_name)."; } } # input date check. returns english date and 1 if true sub true_date(){ my $self = shift; my ($date,$time) = @_; $date =~ s/,/./g; my $d_chck = 0; if($date =~ /(\d{4})-(\d{2})-(\d{2})/){ $d_chck = 1 if(check_date($1,$2,$3)); $date = "$1-$2-$3"; }elsif($date =~ /(\d{2})\.(\d{2})\.(\d{4})/){ $d_chck = 1 if(check_date($3,$2,$1)); $date = "$3-$2-$1"; } return ($date,$d_chck); } # input date check sub checkdate(){ my $self = shift; my ($date,$time) = @_; $date =~ s/,/./g; my $d_chck = 1; my ($c_dd,$c_mm,$c_yy); if($date =~ /(\d{4})-(\d+)-(\d+)/){ $d_chck = 0 if(check_date($1,$2,$3)); $date = "$1-$2-$3"; }elsif($date =~ /(\d+)\.(\d+)\.(\d+)/){ $d_chck = 0 if(check_date($3,$2,$1)); $date = "$1.$2.$3"; } return ($date,$d_chck); } #collect node_name and builds path sub make_uri2(){ my $self = shift; my ($main_id,$lang,$mandantsub_id,$start_id) = @_; my $gpath; my $m_id; my @genpath; my $i=$1 if($main_id =~ /^(\d)/); foreach my $id (sort {$nall->{$b}->{main_id} <=> $nall->{$a}->{main_id}} keys (%$nall)){ #print "xxxx ($main_id =~ /^($i\d+)/) && ($start_id && $main_id >= $start_id) && ($main_id == $nall->{$id}->{main_id})
"; if(($main_id =~ /^($i\d+)/) && ($start_id && $main_id >= $start_id) && ($main_id == $nall->{$id}->{main_id})){ ## wegen multible mandanten sub-sub-level, bsp. Waren/[300] Sonstiges if($mandantsub_id && $i==3){ if($mandantsub_id == $nall->{$id}->{parent_id}){ $i--; $main_id = $nall->{$id}->{parent_id}; $m_id = $nall->{$id}->{main_id} if(!$m_id); $genpath[$i] = "/$nall->{$id}->{node_name}"; #print "$i x/$nall->{$id}->{node_name} ($nall->{$id}->{main_id})
"; } ## }else{ $i--; $main_id = $nall->{$id}->{parent_id}; $main_id = $start_id if($start_id && $i==1); $m_id = $nall->{$id}->{main_id} if(!$m_id); $genpath[$i] = "/$nall->{$id}->{node_name}"; #print "$i /$nall->{$id}->{node_name} ($nall->{$id}->{main_id})
"; } } } foreach (@genpath){ #print "$_|"; $_ =~ s/\/root//; $gpath .= "$_"; } return ("$m_id","$gpath"); } #new init for make_uri3 with returning nall object sub init_nodes5uri(){ my $self = shift; $nall = $db->collect_node4all(); return $nall; } #5. collect node_name and builds path without mandant-logic sub make_uri5(){ my $self = shift; my ($main_id,$nall,$depth_start) = @_; $depth_start = 0 if(!$depth_start); my $gpath; my $m_id; my @genpath; my $depth=$1 if($main_id =~ /^(\d)/ && $main_id >= 100000); foreach my $id (sort {$nall->{$b}->{main_id} <=> $nall->{$a}->{main_id}} keys (%$nall)){ if(($main_id =~ /^($depth\d+)/) && ($main_id == $nall->{$id}->{main_id})){ $depth--; $main_id = $nall->{$id}->{parent_id}; $m_id = $nall->{$id}->{main_id} if(!$m_id); $genpath[$depth] = "/$nall->{$id}->{node_name}" if($depth > $depth_start); #print "$depth|$main_id /$nall->{$id}->{node_name} ($nall->{$id}->{main_id})
"; } } foreach (@genpath){ #print "$_|"; $_ =~ s/\/root//; $gpath .= "$_"; } return ("$m_id","$gpath"); } sub sub4txt(){ my $self = shift; my ($txt,$index,$length,$cut,$cut_last) = @_; my $substrtxt = substr($txt, $index, $length); #$substrtxt =~ s/
/\n/g; #$substrtxt =~ s///g; #$substrtxt =~ s/^[<|\\|\/|>|:|,|\.|\\n]+//g; #$substrtxt =~ s/^\w+\s// if($index > 20); #entferne das erste teil-wort ... if($cut){ $substrtxt =~ s/^[äöü]+//; $substrtxt =~ s/^\w+//; $substrtxt =~ s/^\,//; $substrtxt =~ s/^\.//; } #entferne das letzte teil-wort ... if($cut_last){ $substrtxt =~ s/[äöü]+$//; $substrtxt =~ s/\w+$//; $substrtxt =~ s/\,$//; $substrtxt =~ s/\.$//; } #entferne das letzte teil-wort ... if($index && ($index > $length)){ $substrtxt =~ s/\w+$//; } #$substrtxt =~ s/\s\w+$//; return $substrtxt; } sub newline(){ my $self = shift; my $txtxx = shift; my $not_used = shift || "";#old my $editor = shift || ""; $txtxx =~ s/\r\n/
/g if(!$editor); $txtxx =~ s/\n/
/g if(!$editor); return $txtxx; } #der tiny_mce editor init sub wyedit(){ my $self = shift; my ($users_tiny_mce) = @_; my $wy=""; if($varenv{js4tiny_mce} && $users_tiny_mce){ $wy = ""; } return $wy; } #Komplettset compset logic sub compsum(){ my $self = shift; my ($main_id,$lang,$owner) = @_; my $ct4rel = $db->collect_ct4rel("content",$main_id,$lang);#hash my $ctpers4rel = $db->collect_ctpers4rel($main_id,$lang,$owner);#hash %$ct4rel = (%$ctpers4rel, %$ct4rel);#hash slice return $ct4rel; } # Rounding like "Kaufmannsrunden" # Descr. http://de.wikipedia.org/wiki/Rundung # Inspired by # http://www.perl.com/doc/FAQs/FAQ/oldfaq-html/Q4.13.html sub round(){ my $self = shift; my ($amount) = @_; $amount = $amount * (10**(2)); my $rounded = int($amount + .5 * ($amount<=> 0)) / (10**(2)); return $rounded; } #rounding to half or integer sub round_half(){ my $self = shift; my $amount = shift; $amount = $amount * (10**(2)); my $rounded = int($amount + .5 * ($amount<=> 0)) / (10**(2)); if($rounded =~ /\.\d+/){ $rounded = sprintf('%.2f',$rounded); my $int = 0; ($int, my $dez) = split(/\./,$rounded) if($rounded =~ /\.\d/); if($dez > 0 && $dez <= 50){ $dez = 50; } elsif($dez > 50 && $dez <= 99){ $dez = 00; $int++; } $rounded = $int . "." . $dez; } return $rounded; } #split date (moved partly to Callib) sub split_date(){ my $self = shift; my ($time_db) = @_; $time_db =~ s/:\d{2}\..*$// if($time_db); my ($date,$time) = split(/ /,$time_db); my ($yy,$mo,$dd); ($yy,$mo,$dd) = split(/-/,$date) if($date =~ /\d{4}-/); ($dd,$mo,$yy) = split(/\./,$date) if($date =~ /\d{2}\./); my ($hh,$mi) = split(/\:/,$time); return ($yy,$mo,$dd,$hh,$mi); } #time and date format for DE (moved partly to Callib) sub time4de(){ my $self = shift; my ($time_db,$hhmi,$decode) = @_; $time_db =~ s/:\d{2}\..*$// if($time_db); my ($date,$time) = split(/ /,$time_db); my ($yy,$mo,$dd) = split(/-/,$date); my ($hh,$mi) = split(/\:/,$time); my $date_de = " "; $date_de = "$dd.$mo.$yy"; $date_de = "$dd.$mo.$yy $hh:$mi" if($hhmi); #Deutsch (German) ==> 3 $date_de = Date_to_Text_Long($yy,$mo,$dd,3) if($decode eq "Date_to_Text_Long"); $date_de =~ s/M.*rz/März/; return $date_de; } #error window sub failure(){ my $self = shift; my ($failure,$back) = @_; print "
\n"; print $q->div("$failure"); print $q->div($q->a({-class=>"linknav3",-href=>'javascript:history.back()'}, "[ $back ]")) if($back); print "
\n"; exit 0; } sub failure2(){ my $self = shift; my ($failure,$back) = @_; print "
\n"; print $q->div("$failure"); print $q->div($q->a({-class=>"linknav3",-href=>'javascript:history.back()'}, "[ $back ]")) if($back); print "
\n"; #exit 0; } sub failure3(){ my $self = shift; my ($failure,$back) = @_; print "
\n"; print $q->div("$failure"); print $q->div($q->a({-class=>"linknav3",-href=>'javascript:history.back()'}, "[ $back ]")) if($back); print "
\n"; } #for site-head navigation with breadcrumb and close button sub pathrun(){ my $self = shift; my $path = shift; my @menu = (""); if($path =~ /^\/(.*)/){ @menu = split /\//,$1; } my $node_active; my $crumb; my $h=0; my $backlink; foreach(@menu){ $node_active=$_; $crumb = "$menu[0]" if($h==0); $backlink = "/" if($h==0); $crumb .= " | $menu[1]" if($h==1); $backlink = "/$menu[0]#$menu[1]" if($h==1); #cut long link-name my $length=length($menu[2]); my $cut_last; $cut_last = 1 if($length >= 30); my $menu2 = &sub4txt("",$menu[2],0,30,"","$cut_last"); $crumb .= " | $menu2" if($h==2); $backlink = "/$menu[0]/$menu[1]#$menu[2]" if($h==2); $h++; } return ("$node_active","$crumb","$backlink"); } 1;