#!/Perl
# logfile.pl
# 26/08/2010 - changed 'open' to 'CREATE'
# 16/05/2010 - added 'strip_quotes', 'fix_rel_path3'
use File::Basename;  # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] )

sub open_log {
	my ($f) = shift;
	open $LF, ">$f" or die "ERROR:open_log:logfile.pl: Unable to CREATE $f ...\n";
	$write_log = 1;
}

sub prt {
	my ($msg) = shift;
	if ($write_log) {
		print $LF $msg;
	}
	print $msg;
}

sub mydie {
	my ($msg) = shift;
	if ($write_log) {
		print $LF $msg;
	}
	die $msg;
}

sub close_log {
	my ($of, $p) = @_;
	prt( "Closing LOG and passing $of to system ...\nMay need to CLOSE notepad to exit ...\n") if ($p);
	if ($write_log) {
		close( $LF );
        $write_log = 0;
	}
	system( $of ) if ($p);
}

sub write2file {
	my ($txt,$fil) = @_;
	open WOF, ">$fil" or mydie("ERROR:write2file:logfile.pl: Unable to CREATE [$fil]! $!\n");
	print WOF $txt;
	close WOF;
}

sub write_a_file {
	my ($fil, @txt) = @_;
	open WOF, ">$fil" or mydie("ERROR:write_a_file:logfile.pl: Unable to CREATE $fil! $!\n");
	print WOF @txt;
	close WOF;
}

sub append2file {
	my ($txt,$fil) = @_;
	open WOF, ">>$fil" or mydie("ERROR:append2file:logfile.pl: Unable to open/append to [$fil]! $!\n");
	print WOF $txt;
	close WOF;
}

sub writebinfile {
	my ($txt,$fil) = @_;
	open WOF, ">$fil" or mydie( "ERROR:writebinfile:logfile.pl: Unable to CREATE [$fil]! $! \n" );
	binmode WOF;
	print WOF $txt;
	close WOF;
}


###############################
# some utilities
sub is_in_array {
	my ($itm, @arr) = @_;
	my $max = scalar @arr;
	for (my $k = 0; $k < $max; $k++) {
		if ($arr[$k] eq $itm) {
			return $k + 1;  # return offset plus 1
		}
	}
	return 0;
}

sub trim_all($) {
	my ($ln) = shift;
	$ln =~ s/\n/ /gm;	# replace CR (\n)
	$ln =~ s/\r/ /gm;	# replace LF (\r)
	$ln =~ s/\t/ /g;	# TAB(s) to a SPACE
	$ln = substr($ln,1) while ($ln =~ /^\s/); # remove all LEADING space
	$ln = substr($ln,0, length($ln) - 1) while ($ln =~ /\s$/); # remove all TRAILING space
	$ln =~ s/\s{2}/ /g while ($ln =~ /\s{2}/);	# all double space to SINGLE
	return $ln;
}

sub file_extension {
    my $fil = shift;
    my ($nm,$dir,$ext) = fileparse( $fil, qr/\.[^.]*/ );
    return $ext;
}

sub file_title {
    my $fil = shift;
    my ($nm,$dir,$ext) = fileparse( $fil, qr/\.[^.]*/ );
    return $nm;
}

# Return directory name of file.
sub file_dirname {
    my ($fil) = shift;
    my ($nm,$dir) = fileparse($fil);
    return $dir;
}

# RENAME A FILE TO .OLD, or .BAK
# 0 - do nothing if file does not exist.
# 1 - rename to .OLD if .OLD does NOT exist
# 2 - rename to .BAK, if .OLD already exists,
# 3 - deleting any previous .BAK ...
sub rename2oldbak {
	my ($fil) = shift;
	my $ret = 0;	# assume NO SUCH FILE
	if ( -f $fil ) {	# is there?
		my ($nm,$dir,$ext) = fileparse( $fil, qr/\.[^.]*/ );
		my $nmbo = $dir . $nm . '.old';
		$ret = 1;	# assume renaming to OLD
		if ( -f $nmbo) {	# does OLD exist
			$ret = 2;		# yes - rename to BAK
			$nmbo = $dir . $nm . '.bak';
			if ( -f $nmbo ) {
				$ret = 3;
				unlink $nmbo;
			}
		}
		rename $fil, $nmbo;
	}
	return $ret;
}

#########################################
###### relative path stuff ##############
sub path_u2d($) {
	my ($ud) = shift;
	$ud =~ s/\//\\/g;
	return $ud;
}

sub path_d2u($) {
	my ($du) = shift;
	$du =~ s/\\/\//g;
	return $du;
}

# Given TWO FOLDER, attempt to get RELATIVE PATH from the FROM DIRECTORY,
# to the TARGET DIRECTORY. MUSTS BE DIRECTORIES, NOT FILE PATHS
##my $rel = get_relative_path( $htm_folder, $my_folder ); added 20070820
# seems to work fine ... still under test!!!
# 17/11/2007 - Further refinement to REMOVE all warnings
sub get_relative_path {
	my ($target, $fromdir) = @_;
    my $dbg_rel = 0;
	my ($colonpos, $path, $posval, $diffpos, $from, $to);
	my ($tlen, $flen);
    my ($lento, $lenfrom);
	my $retrel = "";
	# only work with slash - convert DOS backslash to slash
	$target = path_d2u($target);
	$fromdir = path_d2u($fromdir);
	# add '/' to target. if missing
	if (substr($target, length($target)-1, 1) ne '/') {
		$target .= '/';
	}
	# add '/' to fromdir. if missing
	if (substr($fromdir, length($fromdir)-1, 1) ne '/') {
		$fromdir .= '/';
	}

	# remove drives, if present
    if ( ( $colonpos = index( $target, ":" ) ) != -1 ) {
		$target = substr( $target, $colonpos+1 );
	}
	if ( ( $colonpos = index( $fromdir, ":" ) ) != -1 ) {
        $fromdir = substr( $fromdir, $colonpos+1 );
    }
	# got the TO and FROM ...
	$to = $target;
	$from = $fromdir;
	print "To [$to], from [$from] ...\n" if ($dbg_rel);
	$path = '';
	$posval = 0;
	$retrel = '';
    $lento = length($to);
    $lenfrom = length($from);
	# // Step through the paths until a difference is found (ignore slash differences)
	# // or until the end of one is found
	while ( ($posval < $lento) && ($posval < $lenfrom) ) {
		if ( substr($from,$posval,1) eq substr($to,$posval,1) ) {
			$posval++; # bump to next
		} else {
			last; # break;
		}
	}

	# // Save the position of the first difference
	$diffpos = $posval;

	# // Check if the directories are the same or
	# // the if target is in a subdirectory of the fromdir
	if ( ( !substr($from,$posval,1) ) &&
		 ( substr($to,$posval,1) eq "/" || !substr($to,$posval,1) ) )
	{
		# // Build relative path
		$diffpos = length($target);
		if (($posval + 1) < $diffpos) {
			$diffpos-- if ($diffpos);
			if ($diffpos > $posval) {
				$diffpos -= $posval;
			} else {
				$diffpos = 0;
			}
			###$retrel = substr( $target, $posval+1, length( $target ) );
			print "Return substr of target, from ".($posval+1).", for $diffpos length ...\n" if ($dbg_rel);
			$retrel = substr( $target, $posval+1, $diffpos );
		} else {
			print "posval+1 (".($posval+1).") greater than length $diffpos ...\n" if ($dbg_rel);
		}
	} else {
		# // find out how many "../"'s are necessary
		# // Step through the fromdir path, checking for slashes
		# // each slash encountered requires a "../"
		#$posval++;
		while ( substr($from,$posval,1) ) {
			print "Check for slash ... $posval in $from\n" if ($dbg_rel);
			if ( substr($from,$posval,1) eq "/" ) { # || ( substr($from,$posval,1) eq "\\" ) ) {
				print "Found a slash, add a '../' \n" if ($dbg_rel);
				$path .= "../";
			}
			$posval++;
		}
		print "Path [$path] ...\n" if ($dbg_rel);

		# // Search backwards to find where the first common directory
		# // as some letters in the first different directory names
		# // may have been the same
		$diffpos--;
		while ( ( substr($to,$diffpos,1) ne "/" ) && substr($to,$diffpos,1) ) {
			$diffpos--;
		}
		# // Build relative path to return
		$retrel = $path . substr( $target, $diffpos+1, length( $target ) );
    }
	print "Returning [$retrel] ...\n" if ($dbg_rel);
	return $retrel;
}


sub get_rel_dos_path {
	my ($targ, $from) = @_;
	my $rp = get_relative_path($targ, $from);
	$rp = path_u2d($rp);
	return $rp;
}

#########################################
sub strip_quotes {
	my ($ln) = shift;
	if ($ln =~ /^".*"$/) {
		$ln = substr($ln,1,length($ln)-2);
	}
	return $ln;
}
sub fix_rel_path3($$) {
	my ($path,$caller) = @_;
	$path = path_u2d($path);	# ENSURE DOS PATH SEPARATOR (in relative.pl)
	my @a = split(/\\/, $path);
	my $npath = '';
	my $max = scalar @a;
	my @na = ();
	for (my $i = 0; $i < $max; $i++) {
		my $p = $a[$i];
		if ($p eq '.') {
			# ignore this
		} elsif ($p eq '..') {
			if (@na) {
				pop @na;	# discard previous
			} else {
				prtw( "WARNING:$caller: Got relative .. without previous!!! path=$path\n" );
			}
		} else {
			push(@na,$p);
		}
	}
	foreach my $pt (@na) {
		$npath .= "\\" if length($npath);
		$npath .= $pt;
	}
	return $npath;
}

1;

