path2dos.pl to HTML.

index -|- end

Generated: Sat Oct 24 16:35:26 2020 from path2dos.pl 2020/09/11 8.4 KB. text copy

#!/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 = <DIR>;
            close DIR;
            $lnn = 0;
            # 11/03/2014  12:03               310 GITIGN~1     .gitignore
            # 11/03/2014  19:32    <DIR>          BU9B98~1     build-curl
            # 28/01/2014  15:29    <DIR>                       build-fg
            # 09/02/2014  12:03    <DIR>          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 '<DIR>'
                $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 <file>  (-o) = Write output to this file. (def=$out_file)\n");
}



# eof - path2dos.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional