Generated: Sat Oct 24 16:35:14 2020 from dirlist.pl 2016/09/20 11.5 KB. text copy
#!/usr/bin/perl -w # NAME: dirlist.pl # AIM: Given a root directory, scan recursively and list directories found # Exclude REPO directories by default. -a to include # Exclude directories with no files. # 2016-09-20 - Review, and add no recursion # 08/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.2 2015-09-20"; ###my $VERS = "0.0.1 2013-08-08"; my $load_log = 0; my $in_dir = ''; my $verbosity = 0; my $out_file = $temp_dir.$PATH_SEP."tempdlist.txt"; my $no_repos = 0; my $add_glob = 0; my $add_all_dirs = 0; my $cmp_dir = ''; my $recursive = 1; # ### DEBUG ### my $debug_on = 0; my $def_dir = 'C:\FG\fgx-fgdata-2.10.0'; ### program variables my @warnings = (); my $cwd = cwd(); my @repo_dirs = qw( CVS .svn .git .hg ); my $tot_files = 0; my $tot_dirs = 0; my @directories = (); my $base_dir = ''; 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 in_repo_list($) { my $dir = shift; my ($tst); foreach $tst (@repo_dirs) { return 1 if ($tst eq $dir); } return 0; } 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 = $base_dir; return $ff if (length($bs) == 0); $bs .= $PATH_SEP if ( !($bs =~ /(\\|\/)$/) ); return remove_base_path($ff,$bs); } my %cmp_dirs = (); sub in_cmp_dir($) { my $ff = shift; return 1 if (length($cmp_dir) == 0); # no dir to compre it with my $ff2 = $cmp_dir.$ff; return 0 if (! -d $ff2); # no such directory in the 'target' if (!defined $cmp_dirs{$ff2}) { # must scan it and count files my $dir = $ff2; ut_fix_directory(\$dir); my $fcnt = 0; if (opendir(DIR,$ff2)) { my @files = readdir(DIR); closedir(DIR); my ($file,$ff3); foreach $file (@files) { next if ($file eq '.'); next if ($file eq '..'); $ff3 = $dir.$file; if (-d $ff3) { # no interest in sub-directoires here } elsif (-f $ff3) { $fcnt++; last; } else { prtw("WARNING: What is this [$ff3]!\n"); } } } else { prtw("WARNING: Unable to open dir [$ff2]!\n"); } $cmp_dirs{$ff2} = $fcnt; } return $cmp_dirs{$ff2}; } sub process_in_dir($$); sub process_in_dir($$) { my ($dir,$lev) = @_; if (! opendir(DIR,$dir)) { prtw("WARNING: Unable to 'open' directory [$dir]\n"); return; } my @files = readdir(DIR); closedir(DIR); my ($file,$ff,$cnt,$tmp); $cnt = scalar @files; ut_fix_directory(\$dir); $ff = remove_base_dir($dir); if (length($ff)) { my $file_cnt = 0; my $dir_cnt = 0; foreach $file (@files) { next if ($file eq '.'); next if ($file eq '..'); $tmp = $dir.$file; if (-d $tmp) { if ($no_repos && in_repo_list($file)) { # skip this directory } else { $dir_cnt++; } } elsif (-f $tmp) { $file_cnt++; last; } else { prtw("WARNING: What is this [$tmp]\n"); } } if (($file_cnt || $add_all_dirs) && in_cmp_dir($ff)) { $ff .= '*' if ($add_glob); prt("dir: $ff ($cnt items)\n") if (VERB5()); $tot_dirs++; push(@directories,$ff); } } my @dirs = (); foreach $file (@files) { next if ($file eq '.'); next if ($file eq '..'); $ff = $dir.$file; if (-d $ff) { if ($no_repos && in_repo_list($file)) { # skip this directory } else { push(@dirs,$ff); } } elsif (-f $ff) { $tot_files++; } else { prtw("WARNING: What is this [$ff]\n"); } } if ($recursive || ($lev < 2)) { foreach $dir (@dirs) { process_in_dir($dir,$lev+1); } } } sub show_dirs() { my ($dir); my $msg = ''; my $cnt = scalar @directories; foreach $dir (@directories) { $msg .= "$dir\n"; } if (length($out_file)) { write2file($msg,$out_file); prt("List of $cnt directory written to [$out_file]\n"); } else { prt($msg); prt("no out file (-o) given...\n"); } } ######################################### ### MAIN ### parse_args(@ARGV); process_in_dir($in_dir,0); prt("Processed $tot_dirs directories, with $tot_files file...\n"); show_dirs(); 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; } } elsif ($sarg =~ /^a/) { $no_repos = 0; prt("Set to not exclude repos. ($no_repos)\n") if (VERB1()); } elsif ($sarg =~ /^g/) { $add_glob = 1; prt("Set to add glob '*' to each dir. ($add_glob)\n") if (VERB1()); } elsif ($sarg =~ /^o/) { need_arg(@av); shift @av; $sarg = $av[0]; if ($sarg eq '-') { $out_file = ''; prt("Cleared out file.\n") if (VERB1()); } else { $out_file = $sarg; prt("Set out file to [$out_file].\n") if (VERB1()); } } elsif ($sarg =~ /^c/) { need_arg(@av); shift @av; $sarg = $av[0]; $cmp_dir = $sarg; pgm_exit(1,"ERROR: Directory [$cmp_dir] does NOT exist!\n") if (! -d $cmp_dir); prt("Set compare directory to [$cmp_dir].\n") if (VERB1()); } elsif ($sarg =~ /^r/) { $recursive = 0; prt("Set to not recurs into sub-directories\n") if (VERB1()); } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { $in_dir = $arg; pgm_exit(1,"ERROR: Directory [$in_dir] does NOT exist!\n") if (! -d $in_dir); 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) { $in_dir = $def_dir; prt("Set DEFAULT input to [$in_dir]\n"); $no_repos = 1; } } if (length($in_dir) == 0) { pgm_exit(1,"ERROR: No input files found in command!\n"); } if (! -d $in_dir) { pgm_exit(1,"ERROR: Unable to find in folder [$in_dir]! Check name, location...\n"); } $base_dir = $in_dir; ut_fix_directory(\$cmp_dir) if (length($cmp_dir)); } sub give_help { prt("\n"); 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. (def=$load_log) file=$outfile\n"); prt(" --addrepo (-a) = To not exclude repo folders. (def=$no_repos). Ex=".join(",",@repo_dirs).")\n"); prt(" --glob (-g) = To add glob '*' to tail of each directory. (def=$add_glob)\n"); prt(" --nofile (-n) = Include directories with no file.\n"); prt(" --cmp <dir> (-c) = Only include a directory if it exists in this target.\n"); prt(" --out <file> (-o) = Write output to this file. (def=$out_file)\n"); prt(" --recur (-r) = Turn off default recursive seaching. (def=$recursive)\n"); prt("\n"); prt(" AIM: Given a root directory, scan recursively (def=$recursive) and list directories found.\n"); prt(" Exclude REPO directories by default. -a to include.\n"); prt(" Exclude directories with no files. -n to include\n"); prt("\n"); } # eof - template.pl