#!/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