sharee.bike/copri4/main/src/Mod/Libenz.pm
2022-01-09 18:31:20 +01:00

756 lines
20 KiB
Perl
Executable file

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<<EOF
<script>
\$(document).ready(function(){
\$( "#retm" ).fadeOut(7000);
})
</script>
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 eingefuegt" 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 geloescht" if($d_pm);
$feedb = "deleted successfully" if($d_pm && $varenv{html_lang} eq "en");
$feedb = "neue $kind_of_trans Daten eingefuegt" if($i_pl);
$feedb = "$kind_of_trans Daten gespeichert" if($s_pl);
$feedb = "$kind_of_trans Daten geloescht" 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;
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 ", $_ : '&nbsp; x &nbsp;' } @$_;
#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="#86cb00";
}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++;
}
}
my $daycounter = $day_today - 1;
my $daymarker = $raster_mmpx * $daycounter;
$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);
}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);# 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 "<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);
}
#FIXME 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;
}
}
}
#get free Rechnungs Nummer
sub get_freeReNr(){
my $self = shift;
my ($table,$barcode_start,$barcode_end,$column,$content) = @_;
my $now_time = strftime "%Y-%m-%d %H:%M:%S", localtime;
my $freenr = $db->collect_content3("$table","$column","$content");
my $s_id = $barcode_start;
my $e_id = $barcode_end || 100000;
$freenr->{$s_id}->{barcode} = "1000" if(!$freenr->{$s_id}->{barcode});
for (; $s_id < $e_id; $s_id++){
#if($freenr->{$s_id}->{barcode} != $s_id){
if($freenr->{$s_id}->{ct_name} && $freenr->{$s_id}->{ct_name} !~ /^$s_id/){
open(RENR, ">> $varenv{logdir}/get_freeReNr.log");
print RENR "* $now_time --------------- \n";
print RENR "$table,$barcode_start,$barcode_end,$column,$content\n";
print RENR "for (; $s_id < $e_id; $s_id++){\n";
print RENR "if($freenr->{$s_id}->{ct_name} && $freenr->{$s_id}->{ct_name} !~ /^$s_id/){\n";
print RENR "return $s_id;\n";
close RENR;
return $s_id;
}
}
return 0;
}
#CAsh
sub cashme(){
my $self = shift;
my ($cash,$comma) = @_;
$cash = "0\.00" if($cash !~ /\d/);
$cash = "$cash\.00" if($cash !~ /\./);
$cash = $cash . 0 if($cash =~ /\.\d{1}$/);
$cash =~ s/\./$comma/ if($comma);
return $cash;
}
#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})<br>";
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})<br />";
}
##
}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})<br />";
}
}
}
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})<br />";
}
}
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/<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;
my $txtxx = shift;
my $not_used = shift || "";#old
my $editor = shift || "";
$txtxx =~ s/\r\n/<br \/>/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 = "<script type='text/javascript'>
tinyMCE.init({
theme : \"advanced\",
mode : \"textareas\",
});
</script>";
}
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 = "&nbsp;";
$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;