# module for functions
# june 9, 2005
#
# move reusabe functions from template_perl_cgi.pm
#
#
# Functions:

# bytesConvert       

# dateFlip
# dateZeroPadding       
# getFileInfo
# grammarAdjust
# highlight
# listArray    
# myChomp
# thisFileInfo
# time2localtimeStamp
# trimCRLF
# trimSpaces         
# iniFile
# sortField
#
#
#
# Questions contact:
# Stanley Lee
# http://fusionplant.com/contact/



# global variables ##############################################################
my $spacerGif = "/pic/spacer.gif";


# This File Info  #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#
# this file name, path, web path, servername
# to use:
# my ($thisFileName, $thisFilePath, $thisFileWebPath, $thisFileWebServerName)=thisFileInfo();
sub thisFileInfo {
    my $thisFileName;
    my $thisFilePath;
    if ($0 =~ /\//){
    #unix
	$thisFileName = substr ($0, rindex($0, '/')+1, length($0)-1);
	$thisFilePath = substr ($0, 0, rindex($0, '/')+1);
    } elsif($0 =~ /\\/){
    #windows
	$thisFileName = substr ($0, rindex($0,'\\')+1, length($0)-1);
	$thisFilePath = substr ($0, 0, rindex($0,'\\')+1);
    }
    my $thisFileWebPath = substr ($ENV{SCRIPT_NAME}, 0, rindex($ENV{SCRIPT_NAME}, '/')+1);
    my $thisFileWebServerName=$ENV{SERVER_NAME};

    return ($thisFileName, $thisFilePath, $thisFileWebPath, $thisFileWebServerName);
}


# Get File Info  #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#
# get file name, path
# to use:
# my ($fileName, $filePath)=getFileInfo(fullpath);
sub getFileInfo {
    my ($fullpath)=@_;
    my $thisFileName;
    my $thisFilePath;
    if ($fullpath =~ /\//){
    #unix
	$thisFileName = substr ($fullpath, rindex($fullpath, '/')+1, length($fullpath)-1);
	$thisFilePath = substr ($fullpath, 0, rindex($fullpath, '/')+1);
    } elsif($fullpath =~ /\\/){
    #windows
	$thisFileName = substr ($fullpath, rindex($fullpath,'\\')+1, length($fullpath)-1);
	$thisFilePath = substr ($fullpath, 0, rindex($fullpath,'\\')+1);
    }
    return ($thisFileName, $thisFilePath);
}





# trimSpaces # trims white spaces #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-
sub trimSpaces {
    # to use: my ($str1, $str2) = trimSpaces($rawStr1, $rawStr2);
    my @str= @_;
    for (@str) {
	s/^\s+//;
	s/\s+$//;
    }
    return @str;
}



# time() to localtime date and time #-#-#-#-#-#-#-#-#-#-#-#-#-#-#
# time2localtimeStamp( time, long );
# time is date/time serial, or time() function
#
# long: any value for long format
#
sub time2localtimeStamp {
    my ($time, $long)=@_;
    my $returnIt="";
    my @dayOfWeek=qw (Su Mo Tu We Th Fr Sa);
    my @months=("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec");

    @dayOfWeek = qw (Sunday Monday Tuesday Wednesday Thursday Friday Saturday) if $long;
    @months = ("January","February","March","April","May","June","July","August","September","October","November","December") if $long;


    my @localtime = localtime $time;

    # break down @localtime, calculate month, year, etc
    if ($long){
	$returnIt .= "".($dayOfWeek[$localtime[6]]).", ".($months[$localtime[4]])." $localtime[3], ".($localtime[5]+1900)." - - ".sprintf("%02d",$localtime[2]).":".sprintf("%02d",$localtime[1]).":".sprintf("%02d",$localtime[0])."";
    } else {
	$returnIt .= "".($dayOfWeek[$localtime[6]])." ".(sprintf("%02d",$localtime[4]+1))."/".(sprintf("%02d",$localtime[3])). "/".($localtime[5]+1900)." -- ".sprintf("%02d",$localtime[2]).":".sprintf("%02d",$localtime[1]).":".sprintf("%02d",$localtime[0])."";
    }

    # figure AM or PM
    my $amPm;
    if ($localtime[2] == 12){
	$hour=$localtime[2];
	$amPm="PM";
    }
    elsif ($localtime[2] == 0){
	$hour=$localtime[2]+12;
	$amPm="AM";
    }
    elsif ($localtime[2] > 12) {
	$hour=$localtime[2]-12;
	$amPm="PM";
    }
    else {
	$hour=$localtime[2];
	$amPm="AM";
    }

    # show 12 hour format of time
    $returnIt .= "(".sprintf("%02d",$hour).":".sprintf("%02d",$localtime[1]).":".sprintf("%02d",$localtime[0]).$amPm.")" if $long;

    return $returnIt;
}




# highlight #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#
# highlight("<yourTag>textmessage</yourTag>", "color")
# style is appended to yourTag, otherwise <span> is used
# color may be HTML format #ff0000
# Sept 2004
sub highlight {
    my ($text, $color) = @_;
    my $returnIt;


    # find if color exists in arg ###############
    $color = "#ffff00" unless $color;

    # find if tag exists in arg ####################
    if ($text =~ /^(<.+?>)(.+?)(<.+?>)$/){
	# tag found
	my ($tag, $text, $closeTag) = ($1, $2, $3);
	my $style = qq{style="background: $color;"};
	$tag =~ s/>$/ $style>/;
	$returnIt = "$tag$text$closeTag";
    } else {
	# no tag found, will use <span>
	$returnIt = qq{<span style="background: $color">$text</span>};
    }

    return $returnIt;
}



# myChomp # removes trailing \n #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#
# nov 8, 2004
# to use:
# myChomp(@listA, $stringB, @listC, etc...);
sub myChomp {
    for (@_){
	$_ =~ s/\n+$//g;
    }
    return @_;
}



# listArray #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#
# takes list
# processes list, prepends them with numbers
# built: nov 16, 2004
# updated: ...
# to use:
# listArray(@shoppingList);
sub listArray {
    my $c = 0;
    for (@_){
	$_ = "$c $_";
	$c++;
    }
}



# grammarAdjust #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#
# takes single word and determines proper word grammar
# built: Dec 7, 2004
# updated: ...
# to use:
# grammarAdjust("command", "word", <quantity>);
# commands:
# ("plural", "word", <qty>)
# ("possessive", "word", <qty>)
sub grammarAdjust {
    my ($command, $word, $qty) = @_;
    my ($returnIt, $s)=();

    if ($command eq "plural"){
	if ($qty > 1){
	    if (1 == 10){
		# 1 is not 10 of course
	    } elsif ($word =~ m/es$/){
		$returnIt = $word ."es"; # james -> jameses
	    } elsif ($word =~ m/x$/){
		$returnIt = $word . "es"; # box -> boxes
	    } elsif ($word =~ m/ey$/){
		$returnIt = $word =~ s/ey$/ies/; # monkey -> monkies
            } elsif ($word =~ m/oy$/){
                $returnIt = $word . "s"; # boy -> boys
	    } elsif ($word =~ m/^(woman|man)$/){
                $word =~ s/an$/en/; # (wo)man -> (wo)men
		$returnIt = $word;
	    } elsif ($word =~ m/ch$/){
		$returnIt = $word . "es"; # match -> matches
	    } elsif ($word !~ m/s$/){
		$returnIt = $word ."s"; # word -> words
	    }


	} else {
	    $returnIt = $word;
	}
    }
    elsif ($command eq "possessive") {
	if ($qty > 1){
	    $s = $word =~ m/s$/ ? "\'" : "s\'" unless ($word =~ m/es$/);
	    $word =~ s/es$/eses\'/ if ($word =~ m/es$/);
	} else {
	    $s = $word =~ m/s$/ ? "\'" : "\'s" unless ($word =~ m/es$/);
	    $word =~ s/es$/es\'s/ if ($word =~ m/es$/);
	}
	$returnIt = "$word$s";
    }



    return $returnIt;
}




# bytesConvert #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#
# takes bytes and returns human readable format
# adjusts to bytes, kilo, mega, giga
# built: may 10, 2005
# to use:
# (<modified number>, <unit>) = bytesConvert(<number>);
# modified number is in binary bytes kilo, mega, or giga.
# unit is k, m, or g
sub bytesConvert {
    my $bytes = shift @_;
    my $unit = "";

    if ($bytes =~ m/^\d{4,6}$/){
	$unit = "K";
	$bytes = $bytes / 1024;
    } elsif ($bytes =~ m/^\d{7,9}$/){
	$unit = "M";
	$bytes = $bytes / 1048576;
    } elsif ($bytes =~ m/^\d{10,12}$/){
	$unit = "G";
        $bytes = $bytes / 1073741824;
    }

    $bytes = sprintf("%.01f", $bytes);

    $bytes =~ s/\.0$//;

    return ($bytes, $unit);

}





# dates zero padding ############################################
# reformats dates
# force dates to have zero padding, 01, 09
# or removes zero padding, 03 -> 3
# dateZeroPadding( <date MM/DD/YYYY or YYYY/MM/DD>, padding )
# padding is "pad" or blank (no value)
#  if value "pad" is given then month and day will be padded
#  if value is undef then leading zero will be removed, "unpadded"
sub dateZeroPadding {
    my @date = split /\//, $_[0];
    my $pad = $_[1];
    for my $var (@date){
        unless ($var =~ m/\d{4}/){
            if ($pad eq "pad"){
                $var = sprintf("%02d", $var);
            } else {
                $var = $var + 0;
            }
        }
    }
    $_[0] = join '/', @date;
}



# date flip ###################################################
# re-formats dates
# if date is YYYY/MM/DD then date becomes MM/DD/YYYY
# var = dateFlip( <date> )
sub dateFlip {
    my @date = split /\//, $_[0];
    if ($date[0] =~ m/\d{4}/){ #starts with year
        $_ = "$date[1]/$date[2]/$date[0]";
    } else {
        $_ = "$date[2]/$date[0]/$date[1]";
    }
}




# trimCRLF_str # trims excess CRLF/CR/LF above and below series of lines of text #-#-#-#-#-#-#-#-#
# this works for lines in a string
# concieved Aug 2, 2005
# to use: trimSpaces_str($rawStr1, $rawStr2, @arr1);
sub trimCRLF_str {
    for (@_){
	$_ =~ s/^\n+//;
	$_ =~ s/\n+$//;
    }
}


# trimCRLF_arr # trims excess CRLF/CR/LF above and below series of lines of text #-#-#-#-#-#-#-#-#
# this works for elements in an array
# concieved Aug 3, 2005
# to use: @arr1 = trimSpaces_arr(@arr1);
sub trimCRLF_arr {
    my @list = @_;

    for (1,2){
	@list = reverse @list;
	my $c = -1;
        LABEL: for (@list){
	    $c++;
	    if ($list[$c] ne "" and $list[$c] ne "\n" ){
		last LABEL;
	    }
	}
#	$c++;
	splice @list, 0, $c;
    }

    return @list;

}



# iniFile
# ini file handler
# put, get, del
# 4/13/2006
# <$var1 => iniFile (<command>, <fullpath+filename.ext>, <varname>, <value>)
# iniFile ('put', '/dir1/file.ini', 'firstname', 'lee')
# iniFile ('get', '/dir1/file.ini', 'firstname'       )
# iniFile ('del', '/dir1/file.ini', 'firstname'       )
sub iniFile {
    my $returnIt = "";
    my ( $command, $fullPathFileName, $varname, $value ) = @_;
    my (@db, %db);


    open READ, $fullPathFileName;
    @db = <READ>;
    close READ;

    # convert @db to %db from ini file
    for (@db){
        chomp;
        my ($k, $v) = split /=/;
        $db{$k} = $v;
    }

    # command get only
    if ($command =~ /^get$/i){
        $returnIt = $db{$varname};
    }

    # add new var and value or change value
    if ($command =~ /^put$/i){
        $db{$varname} = $value;
    }

    # delete var and value
    if ($command =~ /^del$/i){
        delete $db{$varname};
    }


    # %db write to ini file
    if ($command =~ /^put$/i or $command =~ /^del$/i){
        open WRITE, ">$fullPathFileName";
        while ( my ($k, $v) = each %db){
            print WRITE "$k=$v\n";
        }
        close WRITE;
    }

    return $returnIt;
}







# sort field
# sorts by field
# taken from my original uniDB program
# at the time, learned from comp.lang.perl.misc
# 4/20/2006
# @db = sortField (@db, <field number>, <delimiter>, <method>)
# @db is pipe delimited flatfile database
# field number starting with field 1, a 0 sorts last column (better if not used)
# delimiter like | or space, etc, must be \|
# method: a = alpha, n = numeric, A = ASCII
sub sortField {
    my ($db, $fieldNumber, $delimiter, $method) = @_;
    my @db = @$db;
    my @temp;
    my $colW = $fieldNumber;
    my $colZ = $colW-1;


    if ($method eq "a") {
        @temp = sort {
            my $aa=(split $delimiter, uc($a), $colW)[$colZ];
            my $bb=(split $delimiter, uc($b), $colW)[$colZ];
            $aa=~ s/\W+//g;
            $bb=~ s/\W+//g;
            $aa cmp $bb;
        } @db;
    } elsif ($method eq "n") {
        @temp = sort {
            (split $delimiter, $a, $colW)[$colZ] <=>
            (split $delimiter, $b, $colW)[$colZ]
        } @db;
    } else {
        @temp = sort {
            my $aa=(split $delimiter, $a, $colW)[$colZ];
            my $bb=(split $delimiter, $b, $colW)[$colZ];
            $aa=~ s/\W+//g;
            $bb=~ s/\W+//g;
            $aa cmp $bb;
        } @db;
    }


    return @temp;
}



## END ###############################################
1;
