2021-12-30 12:05:56 +01:00
|
|
|
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',
|
2023-06-21 14:59:05 +02:00
|
|
|
'GB' => 'Vereinigtes Königreich',
|
|
|
|
};
|
|
|
|
return $country;
|
|
|
|
}
|
|
|
|
|
|
|
|
sub country_code_all(){
|
|
|
|
my $self = shift;
|
|
|
|
my $country = {
|
|
|
|
'--' => '----------------------',
|
|
|
|
'AF' => 'Afghanistan',
|
|
|
|
'AX' => 'Åland Islands',
|
|
|
|
'AL' => 'Albania',
|
|
|
|
'DZ' => 'Algeria',
|
|
|
|
'AS' => 'American Samoa',
|
|
|
|
'AD' => 'Andorra',
|
|
|
|
'AO' => 'Angola',
|
|
|
|
'AI' => 'Anguilla',
|
|
|
|
'AQ' => 'Antarctica',
|
|
|
|
'AG' => 'Antigua and Barbuda',
|
|
|
|
'AR' => 'Argentina',
|
|
|
|
'AM' => 'Armenia',
|
|
|
|
'AW' => 'Aruba',
|
|
|
|
'AU' => 'Australia',
|
|
|
|
'AT' => 'Austria',
|
|
|
|
'AZ' => 'Azerbaijan',
|
|
|
|
'BS' => 'Bahamas',
|
|
|
|
'BH' => 'Bahrain',
|
|
|
|
'BD' => 'Bangladesh',
|
|
|
|
'BB' => 'Barbados',
|
|
|
|
'BY' => 'Belarus',
|
|
|
|
'BE' => 'Belgium',
|
|
|
|
'BZ' => 'Belize',
|
|
|
|
'BJ' => 'Benin',
|
|
|
|
'BM' => 'Bermuda',
|
|
|
|
'BT' => 'Bhutan',
|
|
|
|
'BO' => 'Bolivia (Plurinational State of)',
|
|
|
|
'BQ' => 'Bonaire, Sint Eustatius and Saba',
|
|
|
|
'BA' => 'Bosnia and Herzegovina',
|
|
|
|
'BW' => 'Botswana',
|
|
|
|
'BV' => 'Bouvet Island',
|
|
|
|
'BR' => 'Brazil',
|
|
|
|
'IO' => 'British Indian Ocean Territory',
|
|
|
|
'BN' => 'Brunei Darussalam',
|
|
|
|
'BG' => 'Bulgaria',
|
|
|
|
'BF' => 'Burkina Faso',
|
|
|
|
'BI' => 'Burundi',
|
|
|
|
'CV' => 'Cabo Verde',
|
|
|
|
'KH' => 'Cambodia',
|
|
|
|
'CM' => 'Cameroon',
|
|
|
|
'CA' => 'Canada',
|
|
|
|
'KY' => 'Cayman Islands',
|
|
|
|
'CF' => 'Central African Republic',
|
|
|
|
'TD' => 'Chad',
|
|
|
|
'CL' => 'Chile',
|
|
|
|
'CN' => 'China',
|
|
|
|
'CX' => 'Christmas Island',
|
|
|
|
'CC' => 'Cocos (Keeling) Islands',
|
|
|
|
'CO' => 'Colombia',
|
|
|
|
'KM' => 'Comoros',
|
|
|
|
'CG' => 'Congo',
|
|
|
|
'CD' => 'Congo, Democratic Republic of the',
|
|
|
|
'CK' => 'Cook Islands',
|
|
|
|
'CR' => 'Costa Rica',
|
|
|
|
'CI' => 'Côte d\'Ivoire',
|
|
|
|
'HR' => 'Croatia',
|
|
|
|
'CU' => 'Cuba',
|
|
|
|
'CW' => 'Curaçao',
|
|
|
|
'CY' => 'Cyprus',
|
|
|
|
'CZ' => 'Czechia',
|
|
|
|
'DK' => 'Denmark',
|
|
|
|
'DJ' => 'Djibouti',
|
|
|
|
'DM' => 'Dominica',
|
|
|
|
'DO' => 'Dominican Republic',
|
|
|
|
'EC' => 'Ecuador',
|
|
|
|
'EG' => 'Egypt',
|
|
|
|
'SV' => 'El Salvador',
|
|
|
|
'GQ' => 'Equatorial Guinea',
|
|
|
|
'ER' => 'Eritrea',
|
|
|
|
'EE' => 'Estonia',
|
|
|
|
'SZ' => 'Eswatini',
|
|
|
|
'ET' => 'Ethiopia',
|
|
|
|
'FK' => 'Falkland Islands (Malvinas)',
|
|
|
|
'FO' => 'Faroe Islands',
|
|
|
|
'FJ' => 'Fiji',
|
|
|
|
'FI' => 'Finland',
|
|
|
|
'FR' => 'France',
|
|
|
|
'GF' => 'French Guiana',
|
|
|
|
'PF' => 'French Polynesia',
|
|
|
|
'TF' => 'French Southern Territories',
|
|
|
|
'GA' => 'Gabon',
|
|
|
|
'GM' => 'Gambia',
|
|
|
|
'GE' => 'Georgia',
|
|
|
|
#'DE' => 'Germany',
|
|
|
|
'GH' => 'Ghana',
|
|
|
|
'GI' => 'Gibraltar',
|
|
|
|
'GR' => 'Greece',
|
|
|
|
'GL' => 'Greenland',
|
|
|
|
'GD' => 'Grenada',
|
|
|
|
'GP' => 'Guadeloupe',
|
|
|
|
'GU' => 'Guam',
|
|
|
|
'GT' => 'Guatemala',
|
|
|
|
'GG' => 'Guernsey',
|
|
|
|
'GN' => 'Guinea',
|
|
|
|
'GW' => 'Guinea-Bissau',
|
|
|
|
'GY' => 'Guyana',
|
|
|
|
'HT' => 'Haiti',
|
|
|
|
'HM' => 'Heard Island and McDonald Islands',
|
|
|
|
'VA' => 'Holy See',
|
|
|
|
'HN' => 'Honduras',
|
|
|
|
'HK' => 'Hong Kong',
|
|
|
|
'HU' => 'Hungary',
|
|
|
|
'IS' => 'Iceland',
|
|
|
|
'IN' => 'India',
|
|
|
|
'ID' => 'Indonesia',
|
|
|
|
'IR' => 'Iran (Islamic Republic of)',
|
|
|
|
'IQ' => 'Iraq',
|
|
|
|
'IE' => 'Ireland',
|
|
|
|
'IM' => 'Isle of Man',
|
|
|
|
'IL' => 'Israel',
|
|
|
|
'IT' => 'Italy',
|
|
|
|
'JM' => 'Jamaica',
|
|
|
|
'JP' => 'Japan',
|
|
|
|
'JE' => 'Jersey',
|
|
|
|
'JO' => 'Jordan',
|
|
|
|
'KZ' => 'Kazakhstan',
|
|
|
|
'KE' => 'Kenya',
|
|
|
|
'KI' => 'Kiribati',
|
|
|
|
'KP' => 'Korea (Democratic People\'s Republic of)',
|
|
|
|
'KR' => 'Korea, Republic of',
|
|
|
|
'KW' => 'Kuwait',
|
|
|
|
'KG' => 'Kyrgyzstan',
|
|
|
|
'LA' => 'Lao People\'s Democratic Republic',
|
|
|
|
'LV' => 'Latvia',
|
|
|
|
'LB' => 'Lebanon',
|
|
|
|
'LS' => 'Lesotho',
|
|
|
|
'LR' => 'Liberia',
|
|
|
|
'LY' => 'Libya',
|
|
|
|
'LI' => 'Liechtenstein',
|
|
|
|
'LT' => 'Lithuania',
|
|
|
|
'LU' => 'Luxembourg',
|
|
|
|
'MO' => 'Macao',
|
|
|
|
'MG' => 'Madagascar',
|
|
|
|
'MW' => 'Malawi',
|
|
|
|
'MY' => 'Malaysia',
|
|
|
|
'MV' => 'Maldives',
|
|
|
|
'ML' => 'Mali',
|
|
|
|
'MT' => 'Malta',
|
|
|
|
'MH' => 'Marshall Islands',
|
|
|
|
'MQ' => 'Martinique',
|
|
|
|
'MR' => 'Mauritania',
|
|
|
|
'MU' => 'Mauritius',
|
|
|
|
'YT' => 'Mayotte',
|
|
|
|
'MX' => 'Mexico',
|
|
|
|
'FM' => 'Micronesia (Federated States of)',
|
|
|
|
'MD' => 'Moldova, Republic of',
|
|
|
|
'MC' => 'Monaco',
|
|
|
|
'MN' => 'Mongolia',
|
|
|
|
'ME' => 'Montenegro',
|
|
|
|
'MS' => 'Montserrat',
|
|
|
|
'MA' => 'Morocco',
|
|
|
|
'MZ' => 'Mozambique',
|
|
|
|
'MM' => 'Myanmar',
|
|
|
|
'NA' => 'Namibia',
|
|
|
|
'NR' => 'Nauru',
|
|
|
|
'NP' => 'Nepal',
|
|
|
|
'NL' => 'Netherlands',
|
|
|
|
'NC' => 'New Caledonia',
|
|
|
|
'NZ' => 'New Zealand',
|
|
|
|
'NI' => 'Nicaragua',
|
|
|
|
'NE' => 'Niger',
|
|
|
|
'NG' => 'Nigeria',
|
|
|
|
'NU' => 'Niue',
|
|
|
|
'NF' => 'Norfolk Island',
|
|
|
|
'MK' => 'North Macedonia',
|
|
|
|
'MP' => 'Northern Mariana Islands',
|
|
|
|
'NO' => 'Norway',
|
|
|
|
'OM' => 'Oman',
|
|
|
|
'PK' => 'Pakistan',
|
|
|
|
'PW' => 'Palau',
|
|
|
|
'PS' => 'Palestine, State of',
|
|
|
|
'PA' => 'Panama',
|
|
|
|
'PG' => 'Papua New Guinea',
|
|
|
|
'PY' => 'Paraguay',
|
|
|
|
'PE' => 'Peru',
|
|
|
|
'PH' => 'Philippines',
|
|
|
|
'PN' => 'Pitcairn',
|
|
|
|
'PL' => 'Poland',
|
|
|
|
'PT' => 'Portugal',
|
|
|
|
'PR' => 'Puerto Rico',
|
|
|
|
'QA' => 'Qatar',
|
|
|
|
'RE' => 'Réunion',
|
|
|
|
'RO' => 'Romania',
|
|
|
|
'RU' => 'Russian Federation',
|
|
|
|
'RW' => 'Rwanda',
|
|
|
|
'BL' => 'Saint Barthélemy',
|
|
|
|
'SH' => 'Saint Helena, Ascension and Tristan da Cunha',
|
|
|
|
'KN' => 'Saint Kitts and Nevis',
|
|
|
|
'LC' => 'Saint Lucia',
|
|
|
|
'MF' => 'Saint Martin (French part)',
|
|
|
|
'PM' => 'Saint Pierre and Miquelon',
|
|
|
|
'VC' => 'Saint Vincent and the Grenadines',
|
|
|
|
'WS' => 'Samoa',
|
|
|
|
'SM' => 'San Marino',
|
|
|
|
'ST' => 'Sao Tome and Principe',
|
|
|
|
'SA' => 'Saudi Arabia',
|
|
|
|
'SN' => 'Senegal',
|
|
|
|
'RS' => 'Serbia',
|
|
|
|
'SC' => 'Seychelles',
|
|
|
|
'SL' => 'Sierra Leone',
|
|
|
|
'SG' => 'Singapore',
|
|
|
|
'SX' => 'Sint Maarten (Dutch part)',
|
|
|
|
'SK' => 'Slovakia',
|
|
|
|
'SI' => 'Slovenia',
|
|
|
|
'SB' => 'Solomon Islands',
|
|
|
|
'SO' => 'Somalia',
|
|
|
|
'ZA' => 'South Africa',
|
|
|
|
'GS' => 'South Georgia and the South Sandwich Islands',
|
|
|
|
'SS' => 'South Sudan',
|
|
|
|
'ES' => 'Spain',
|
|
|
|
'LK' => 'Sri Lanka',
|
|
|
|
'SD' => 'Sudan',
|
|
|
|
'SR' => 'Suriname',
|
|
|
|
'SJ' => 'Svalbard and Jan Mayen',
|
|
|
|
'SE' => 'Sweden',
|
|
|
|
'CH' => 'Switzerland',
|
|
|
|
'SY' => 'Syrian Arab Republic',
|
|
|
|
'TW' => 'Taiwan, Province of China',
|
|
|
|
'TJ' => 'Tajikistan',
|
|
|
|
'TZ' => 'Tanzania, United Republic of',
|
|
|
|
'TH' => 'Thailand',
|
|
|
|
'TL' => 'Timor-Leste',
|
|
|
|
'TG' => 'Togo',
|
|
|
|
'TK' => 'Tokelau',
|
|
|
|
'TO' => 'Tonga',
|
|
|
|
'TT' => 'Trinidad and Tobago',
|
|
|
|
'TN' => 'Tunisia',
|
|
|
|
'TR' => 'Turkey',
|
|
|
|
'TM' => 'Turkmenistan',
|
|
|
|
'TC' => 'Turks and Caicos Islands',
|
|
|
|
'TV' => 'Tuvalu',
|
|
|
|
'UG' => 'Uganda',
|
|
|
|
'UA' => 'Ukraine',
|
|
|
|
'AE' => 'United Arab Emirates',
|
|
|
|
'GB' => 'United Kingdom of Great Britain and Northern Ireland',
|
|
|
|
'US' => 'United States of America',
|
|
|
|
'UM' => 'United States Minor Outlying Islands',
|
|
|
|
'UY' => 'Uruguay',
|
|
|
|
'UZ' => 'Uzbekistan',
|
|
|
|
'VU' => 'Vanuatu',
|
|
|
|
'VE' => 'Venezuela (Bolivarian Republic of)',
|
|
|
|
'VN' => 'Viet Nam',
|
|
|
|
'VG' => 'Virgin Islands (British)',
|
|
|
|
'VI' => 'Virgin Islands (U.S.)',
|
|
|
|
'WF' => 'Wallis and Futuna',
|
|
|
|
'EH' => 'Western Sahara',
|
|
|
|
'YE' => 'Yemen',
|
|
|
|
'ZM' => 'Zambia',
|
|
|
|
'ZW' => 'Zimbabwe',
|
2021-12-30 12:05:56 +01:00
|
|
|
};
|
|
|
|
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;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
#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;
|
2022-04-05 12:29:58 +02:00
|
|
|
$factor = sprintf('%.3f',$factor);
|
2021-12-30 12:05:56 +01:00
|
|
|
|
|
|
|
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"){
|
2022-09-15 17:06:08 +02:00
|
|
|
$bg="#009899";
|
2021-12-30 12:05:56 +01:00
|
|
|
}else{
|
|
|
|
$bg="silver";
|
|
|
|
}
|
|
|
|
$day4month .= "<div style='float:left;min-width:$raster_mmpx;border-bottom: solid thin gray;background-color:$bg;height:1.5em;padding:0.3em 0em;' nowrap>|$days[$i] $_</div>\n";
|
|
|
|
}
|
|
|
|
$i++;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2022-11-22 18:10:06 +01:00
|
|
|
my $daymarker = $raster_mmpx * ($day_today - 0.5);
|
|
|
|
#my $daymarker = $raster_mmpx * $day_today;
|
2021-12-30 12:05:56 +01:00
|
|
|
$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 "<br />($u_id,$year_st,$mon_st,$day_st,$hh_st,$mm_st,$year_en,$mon_en,$day_en,$hh_en,$mm_en)<br />";
|
|
|
|
#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)){<br>";
|
|
|
|
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);
|
2022-11-21 12:21:39 +01:00
|
|
|
#}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
|
2021-12-30 12:05:56 +01:00
|
|
|
}
|
2022-11-21 12:21:39 +01:00
|
|
|
|
2021-12-30 12:05:56 +01:00
|
|
|
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 "<br />$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)<br>";
|
|
|
|
#$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 |<br>";
|
|
|
|
|
|
|
|
#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<br />";
|
|
|
|
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);
|
|
|
|
}
|
|
|
|
|
2022-02-14 16:06:02 +01:00
|
|
|
#TODO or change to barcode=c_id
|
2021-12-30 12:05:56 +01:00
|
|
|
#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);
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
sub sub4txt(){
|
|
|
|
my $self = shift;
|
|
|
|
my ($txt,$index,$length,$cut,$cut_last) = @_;
|
|
|
|
my $substrtxt = substr($txt, $index, $length);
|
|
|
|
#$substrtxt =~ s/<br \/>/\n/g;
|
|
|
|
#$substrtxt =~ s/<b.?//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;
|
2022-12-19 14:21:53 +01:00
|
|
|
my $txtxx = shift || "";
|
2021-12-30 12:05:56 +01:00
|
|
|
my $not_used = shift || "";#old
|
|
|
|
my $editor = shift || "";
|
2022-12-19 14:21:53 +01:00
|
|
|
if($txtxx && !$editor){
|
|
|
|
$txtxx =~ s/\r\n/<br \/>/g;
|
|
|
|
$txtxx =~ s/\n/<br \/>/g;
|
2021-12-30 12:05:56 +01:00
|
|
|
}
|
2022-12-19 14:21:53 +01:00
|
|
|
return $txtxx;
|
2021-12-30 12:05:56 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
# 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);
|
|
|
|
}
|
|
|
|
|
2023-03-05 20:01:47 +01:00
|
|
|
#time and date format for DE
|
2021-12-30 12:05:56 +01:00
|
|
|
sub time4de(){
|
|
|
|
my $self = shift;
|
2023-03-05 20:01:47 +01:00
|
|
|
my $time_db = shift;
|
|
|
|
my $hhmi = shift || "";
|
|
|
|
my $decode = shift || "";
|
|
|
|
|
2021-12-30 12:05:56 +01:00
|
|
|
$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 "<div id='Inhalt3'>\n";
|
|
|
|
print $q->div("$failure");
|
|
|
|
print $q->div($q->a({-class=>"linknav3",-href=>'javascript:history.back()'}, "[ $back ]")) if($back);
|
|
|
|
print "</div>\n";
|
|
|
|
exit 0;
|
|
|
|
}
|
|
|
|
|
|
|
|
sub failure2(){
|
|
|
|
my $self = shift;
|
|
|
|
my ($failure,$back) = @_;
|
|
|
|
print "<div style='background-color:white;'>\n";
|
|
|
|
print $q->div("$failure");
|
|
|
|
print $q->div($q->a({-class=>"linknav3",-href=>'javascript:history.back()'}, "[ $back ]")) if($back);
|
|
|
|
print "</div>\n";
|
|
|
|
#exit 0;
|
|
|
|
}
|
|
|
|
|
|
|
|
sub failure3(){
|
|
|
|
my $self = shift;
|
|
|
|
my ($failure,$back) = @_;
|
|
|
|
print "<div style='padding:0 1em;background-color:red;color:white;'>\n";
|
|
|
|
print $q->div("$failure");
|
|
|
|
print $q->div($q->a({-class=>"linknav3",-href=>'javascript:history.back()'}, "[ $back ]")) if($back);
|
|
|
|
print "</div>\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 = "<a style='text-decoration:none;' href='/$menu[0]'>$menu[0]</a>" if($h==0);
|
|
|
|
$backlink = "/" if($h==0);
|
|
|
|
$crumb .= " | <a style='text-decoration:none;' href='/$menu[0]/$menu[1]'>$menu[1]</a>" 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 .= " | <a style='text-decoration:none;' href='/$menu[0]/$menu[1]/$menu[2]'>$menu2</a>" if($h==2);
|
|
|
|
$backlink = "/$menu[0]/$menu[1]#$menu[2]" if($h==2);
|
|
|
|
$h++;
|
|
|
|
}
|
|
|
|
return ("$node_active","$crumb","$backlink");
|
|
|
|
}
|
|
|
|
|
|
|
|
1;
|
2023-06-21 14:59:05 +02:00
|
|
|
|
|
|
|
|