Generated: Sat Oct 12 17:22:51 2013 from dir2bat.pl 2013/08/11 9.1 KB. text copy
#!/usr/bin/perl -w # NAME: dir2bat.pl # AIM: HIGHLY SPECIFIC - Scan C:\FG\18 getting all subdirectorie, then scan # c:\MDOS\*.bat files, and out a list matching the folder with a batch file # 11/08/2013 geoff mclane http://geoffair.net/mperl use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use Cwd; my $os = $^O; my $perl_dir = '/home/geoff/bin'; my $PATH_SEP = '/'; my $temp_dir = '/tmp'; if ($os =~ /win/i) { $perl_dir = 'C:\GTools\perl'; $temp_dir = $perl_dir; $PATH_SEP = "\\"; } unshift(@INC, $perl_dir); require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl' Check paths in \@INC...\n"; # log file stuff our ($LF); my $pgmname = $0; if ($pgmname =~ /(\\|\/)/) { my @tmpsp = split(/(\\|\/)/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $temp_dir.$PATH_SEP."temp.$pgmname.txt"; open_log($outfile); # user variables my $VERS = "0.0.1 2013-03-17"; my $load_log = 0; my $in_dir = 'C:\FG\18'; my $bat_dir = 'C:\MDOS'; my $verbosity = 0; my $out_file = $temp_dir.$PATH_SEP."tempblist.txt"; # ### DEBUG ### my $debug_on = 0; my $def_file = 'def_file'; ### program variables my @warnings = (); my $cwd = cwd(); sub VERB1() { return $verbosity >= 1; } sub VERB2() { return $verbosity >= 2; } sub VERB5() { return $verbosity >= 5; } sub VERB9() { return $verbosity >= 9; } sub show_warnings($) { my ($val) = @_; if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS...\n" ); foreach my $itm (@warnings) { prt("$itm\n"); } prt("\n"); } else { prt( "\nNo warnings issued.\n\n" ) if (VERB9()); } } 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 prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } sub process_in_file($) { my ($inf) = @_; if (! open INF, "<$inf") { pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); } my @lines = <INF>; close INF; my $lncnt = scalar @lines; prt("Processing $lncnt lines, from [$inf]...\n"); my ($line,$inc,$lnn); $lnn = 0; foreach $line (@lines) { chomp $line; $lnn++; if ($line =~ /\s*#\s*include\s+(.+)$/) { $inc = $1; prt("$lnn: $inc\n"); } } } sub remove_base_path($$) { my ($ln, $bs) = @_; my $ln2 = path_d2u($ln); my $bs2 = path_d2u($bs); my $len1 = length($ln2); my $len2 = length($bs2); if ($len1 < $len2) { return $ln; } my ($i,$c1,$c2); for ($i = 0; $i < $len2; $i++) { $c1 = lc(substr($ln2,$i,1)); $c2 = lc(substr($bs2,$i,1)); if ($c1 ne $c2) { return $ln; } } return substr($ln,$len2); } sub remove_base_dir($) { my $ff = shift; my $bs = $bat_dir; return $ff if (length($bs) == 0); $bs .= $PATH_SEP if ( !($bs =~ /(\\|\/)$/) ); return remove_base_path($ff,$bs); } sub scan_in_dir() { my $icnt = 0; my $dir = $in_dir; my $bats = $bat_dir; if (! opendir(DIR,$dir) ) { prg_exit(1,"ERROR: Unable to open directory $dir\n"); } my @files = readdir(DIR); closedir(DIR); $icnt = scalar @files; prt("Got $icnt items in $dir\n"); if (! opendir(DIR,$bats)) { prg_exit(1,"ERROR: Unable to open directory $bats\n"); } my @batfiles = readdir(DIR); closedir(DIR); $icnt = scalar @batfiles; prt("Got $icnt items in $bats\n"); ut_fix_directory(\$dir); ut_fix_directory(\$bats); my ($file,$ff, $dcnt, $bcnt,$tot_mdos,$j,@lines,$line,$len); my @dirs = (); my @bats = (); $tot_mdos = 0; my $max_dlen = 0; foreach $file (@files) { next if ($file eq '.'); next if ($file eq '..'); $ff = $dir.$file; if (-d $ff) { $len = length($file); $max_dlen = $len if ($len > $max_dlen); push(@dirs,[$ff,$file]); } } foreach $file (@batfiles) { next if ($file eq '.'); next if ($file eq '..'); $ff = $bats.$file; if (-f $ff) { $tot_mdos++; if ($file =~ /\.bat$/i) { push(@bats,$ff); } } } $dcnt = scalar @dirs; $bcnt = scalar @bats; prt("Got $dcnt directories to find in $bcnt bat files of $tot_mdos files...\n"); my %finds = (); my ($rh,$cnt,$base); $cnt = 0; foreach $ff (@bats) { $cnt++; prt("$cnt of $bcnt: Checking BAT $ff...\n"); if (open INF, "<$ff") { @lines = <INF>; close INF; foreach $line (@lines) { chomp $line; # But NOT if the line starts with an '@echo ' # next if ($line /^\s*\@echo\s+/i) # no, only interested in lines that begin with CD next if ( !($line =~ /^\s*\@cd\s+/i) ); for ($j = 0; $j < $dcnt; $j++) { $file = $dirs[$j][1]; #if ($line =~ /$file/) { if ($line =~ /(\\|\/)$file(\\|\/|\b)/) { # line contains this directory - store it $finds{$file} = {} if (!defined $finds{$file}); $rh = $finds{$file}; $base = remove_base_path($ff,$bats); ${$rh}{$base} = 1; # store each BAT file only once for this DIRECTORY ###push(@{$ra},$ff); # this BAT contains this direco } } } } else { prtw("WARNING: Unable to open [$ff]!\n"); } } # all in %finds my ($key,$val,$msg,@all); @all = (); foreach $key (sort keys %finds) { $rh = $finds{$key}; $msg = $key; $msg .= ' ' while (length($msg) < $max_dlen); $msg .= ' '; foreach $val (sort keys %{$rh}) { $msg .= "$val "; } prt("$msg\n"); push(@all,$msg); } if (length($out_file)) { write2file(join("\n",@all)."\n",$out_file); prt("List written to [$out_file]\n"); } } ######################################### ### MAIN ### ##parse_args(@ARGV); ##process_in_file($in_dir); scan_in_dir(); 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); 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); } } prt("Verbosity = $verbosity\n") if (VERB1()); } elsif ($sarg =~ /^l/) { if ($sarg =~ /^ll/) { $load_log = 2; } else { $load_log = 1; } prt("Set to load log at end. ($load_log)\n") if (VERB1()); } elsif ($sarg =~ /^o/) { need_arg(@av); shift @av; $sarg = $av[0]; $out_file = $sarg; prt("Set out file to [$out_file].\n") if (VERB1()); } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { $in_dir = $arg; prt("Set input to [$in_dir]\n") if (VERB1()); } shift @av; } if ($debug_on) { prtw("WARNING: DEBUG is ON!\n"); if ((length($in_dir) == 0) && $debug_on) { $in_dir = $def_file; prt("Set DEFAULT input to [$in_dir]\n"); } } if (length($in_dir) == 0) { pgm_exit(1,"ERROR: No input files found in command!\n"); } if (! -f $in_dir) { pgm_exit(1,"ERROR: Unable to find in file [$in_dir]! Check name, location...\n"); } } sub give_help { prt("$pgmname: version $VERS\n"); prt("Usage: $pgmname [options] in-file\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.\n"); } # eof - template.pl