#!/usr/bin/perl
use strict;
use warnings;
# 23/08/2020 - put out file in perl dir, not in 'temp'
# 2020-04-09 - check for options, report, and exit
# 2014-03-12 - Initial cut
my $perl_dir = 'C:\GTools\perl';
my $out_file = $perl_dir.'\temppath.txt';
my $pgmname = $0;
if ($pgmname =~ /(\\|\/)/) {
my @tmpsp = split(/(\\|\/)/,$pgmname);
$pgmname = $tmpsp[-1];
}
# user variables
my $VERS = "0.0.10 2020-05-15";
my $load_log = 0;
my $in_file = '';
my $verbosity = 0;
my @in_files = ();
# ### DEBUG ###
my $debug_on = 0;
my $def_file = 'def_file';
sub VERB1() { return $verbosity >= 1; }
sub VERB2() { return $verbosity >= 2; }
sub VERB5() { return $verbosity >= 5; }
sub VERB9() { return $verbosity >= 9; }
sub prt($) { print shift; }
sub pgm_exit($$) {
my ($val,$msg) = @_;
if (length($msg)) {
$msg .= "\n" if (!($msg =~ /\n$/));
prt($msg);
}
#show_warnings($val);
#close_log($outfile,$load_log);
exit($val);
}
sub trim_leading($) {
my ($ln) = shift;
$ln = substr($ln,1) while ($ln =~ /^\s/); # remove all LEADING space
return $ln;
}
sub trim_tailing($) {
my ($ln) = shift;
$ln = substr($ln,0, length($ln) - 1) while ($ln =~ /\s$/g); # remove all TRAILING space
return $ln;
}
sub trim_ends($) {
my ($ln) = shift;
$ln = trim_tailing($ln); # remove all TRAINING space
$ln = trim_leading($ln); # remove all LEADING space
return $ln;
}
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 = trim_ends($ln);
$ln =~ s/\s{2}/ /g while ($ln =~ /\s{2}/); # all double space to SINGLE
return $ln;
}
sub mydie($) {
my $txt = shift;
prt($txt);
exit(1);
}
sub write2file {
my ($txt,$fil) = @_;
open WOF, ">$fil" or mydie("ERROR: Unable to open $fil! $!\n");
print WOF $txt;
close WOF;
}
sub do_dir($) {
my $tmp = shift;
my (@arr,$path,$file,@arr2,$ln,$lnn,@arr3,$len,$dir,$name);
my ($i,$max,$i2,$seek,$fl,$test,$j,$dos,$fnd);
my (@lines);
my $newpath = '';
prt("Converting [$tmp]\n") if (VERB2());
$tmp =~ s/\//\\/g;
@arr = split(/\\/,$tmp);
$path = '';
$max = scalar @arr;
for ($i = 0; $i < $max; $i++) {
$i2 = $i + 1;
$file = $arr[$i];
$path .= "\\" if (length($path));
$path .= $file;
$test = $path;
if ($i2 < $max) {
$seek = $arr[$i2];
$fl = substr($seek,0,1);
$test .= "\\$fl*"
} else {
$seek = 'LAST';
last;
}
$newpath = $file if ($file =~ /^\w+:$/);
if (open (DIR, "dir /X \"$test\"|")) {
@arr2 =
;
close DIR;
$lnn = 0;
# 11/03/2014 12:03 310 GITIGN~1 .gitignore
# 11/03/2014 19:32 BU9B98~1 build-curl
# 28/01/2014 15:29 build-fg
# 09/02/2014 12:03 BU568F~1 build-fgrun
$len = scalar @arr2;
prt("dir of [$test], seeking [$seek] in $len lines\n") if (VERB5());
$fnd = 0;
@lines = (); # clear lines
foreach $ln (@arr2) {
$lnn++;
chomp $ln;
$ln = trim_all($ln);
$len = length($ln);
next if ($len == 0);
next if ($ln =~ /^Volume/);
next if ($ln =~ /^Directory/);
next if ($ln =~ /^\d+\s+File\(s\)/);
next if ($ln =~ /^\d+\s+Dir\(s\)/);
@arr3 = split(/\s+/,$ln);
$len = scalar @arr3;
next if ($len < 4);
$dir = $arr3[2]; # is ''
$dos = $arr3[3];
$name = $dos;
if ($len > 4) {
$name = $arr3[4];
for ($j = 5; $j < $len; $j++) {
$name .= ' '.$arr3[$j]
}
}
next if ($name eq '.');
next if ($name eq '..');
if (lc($seek) eq lc($name)) {
$newpath .= "\\" if (length($newpath));
$newpath .= $dos;
prt("$lnn: Found [$dos] newpath [$newpath]\n") if (VERB1());
$fnd = 1;
last;
} else {
prt("$lnn: [$dos] [$name] [$ln]\n") if (VERB9());
push(@lines,$ln);
}
}
if (!$fnd) {
$len = scalar @lines;
prt("Did NOT find [$seek] in $len lines...\n");
prt(join("\n",@lines)."\n");
prt("*** FIX ME if you can ***\n");
}
} else {
prt( "dir $path FAILED! ... $! ...\n" );
}
}
if (VERB1()) {
prt("Converted [$tmp]\n");
prt("New PATH [$newpath]\n");
write2file($newpath,$out_file);
prt("Written to outfile $out_file\n");
} else {
prt("$newpath\n");
}
}
#if (@ARGV) {
# foreach my $dir (@ARGV) {
# if ($dir =~ /^-/) {
# prt("Usage: path2dos dir1 [dir2[ dir3[ ...]]]\nNo other options available.\n");
# prt("Will convert path(s) first with Window path sep., then to OLD 8.3 DOS format.\n");
# exit(0);
# }
# do_dir($dir);
# }
# exit(0);
#} else {
# print "No command! Give path to convert...\n";
# exit(1);
#}
#########################################
### MAIN ###
parse_args(@ARGV);
do_dir($in_file);
pgm_exit(0,"");
########################################
########################################
sub need_arg {
my ($arg,@av) = @_;
pgm_exit(1,"ERROR: [$arg] must have a following argument!\n") if (!@av);
}
sub parse_args {
my (@av) = @_;
my ($arg,$sarg);
my $verb = VERB2();
while (@av) {
$arg = $av[0];
if ($arg =~ /^-/) {
$sarg = substr($arg,1);
$sarg = substr($sarg,1) while ($sarg =~ /^-/);
if (($sarg =~ /^h/i)||($sarg eq '?')) {
give_help();
pgm_exit(0,"Help exit(0)");
} elsif ($sarg =~ /^v/) {
if ($sarg =~ /^v.*(\d+)$/) {
$verbosity = $1;
} else {
while ($sarg =~ /^v/) {
$verbosity++;
$sarg = substr($sarg,1);
}
}
$verb = VERB2();
prt("Verbosity = $verbosity\n") if ($verb);
# } elsif ($sarg =~ /^l/) {
# if ($sarg =~ /^ll/) {
# $load_log = 2;
# } else {
# $load_log = 1;
# }
# prt("Set to load log at end. ($load_log)\n") if ($verb);
} elsif ($sarg =~ /^o/) {
need_arg(@av);
shift @av;
$sarg = $av[0];
$out_file = $sarg;
prt("Set out file to [$out_file].\n") if ($verb);
} else {
pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n");
}
} else {
$in_file = $arg;
prt("Set input to [$in_file]\n") if ($verb);
}
shift @av;
}
if ($debug_on) {
prtw("WARNING: DEBUG is ON!\n");
if (length($in_file) == 0) {
$in_file = $def_file;
prt("Set DEFAULT input to [$in_file]\n");
}
}
if (length($in_file) == 0) {
pgm_exit(1,"ERROR: No input directory found in command!\n");
}
#if (! -f $in_file) {
# pgm_exit(1,"ERROR: Unable to find in file [$in_file]! Check name, location...\n");
#}
}
sub give_help {
prt("$pgmname: version $VERS\n");
prt("Usage: $pgmname [options] in-directory\n");
prt("Options:\n");
prt(" --help (-h or -?) = This help, and exit 0.\n");
prt(" --verb[n] (-v) = Bump [or set] verbosity. def=$verbosity\n");
#prt(" --load (-l) = Load LOG at end. ($outfile)\n");
prt(" --out (-o) = Write output to this file. (def=$out_file)\n");
}
# eof - path2dos.pl