Generated: Mon Aug 29 19:34:32 2016 from filelist.pl 2016/03/06 18.4 KB. text copy
#!/perl -w # NAME: filelist.pl # AIM: Write a complete list of files, recursively in a directory, to be used by say a zip # utility. It excludes .svn, .git, and CVS directories from the list, # and excludes such things as *.obj, etc # 06/03/2016 - some UI enhancments 1 - no recursive search # 2009/10/13 - geoff mclane - http://geoffair.net/mperl/ use strict; use warnings; use File::Basename; use Cwd; use File::stat; unshift(@INC, 'C:\GTools\perl'); require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /\w{1}:\\.*/) { my @tmpsp = split(/\\/,$pgmname); $pgmname = $tmpsp[-1]; } my $perl_dir = 'C:\GTools\perl'; my $outfile = $perl_dir."\\temp.$pgmname.txt"; open_log($outfile); # user variables my $load_log = 0; my $in_dir = ''; my $root_dir = ''; my $out_file = $perl_dir."\\templist.txt"; my $verbosity = 1; my $recursive = 1; my %exclude_dirs = ( '.svn' => 1, 'CVS' => 2, '.git' => 3 ); my @excluded_exts = qw( .old .bak .obj .err .pdb .lst .pch .ilk .NCB .plg .OPT .idb .aps .sbr .suo .user .res .dep .exp .manifest .htm .lib .dll .exe .bsc .zip .gz .tar .bz2 ); my @include_exts = (); my @exclude_files = (); ### debug my $dbg01 = 0; # show prt( "[dbg01] $pgmname: in [$cwd]: Hello, World...\n" ) if ($dbg01); my $dbg02 = 0; # prt( "[dbg02] Scanned $total_dirs directories, for $total_files files, ".get_size_msg($total_size)." bytes...\n" ) if ($dbg02); my $dbg03 = 0; # prt( "[dbg03] Out $cnt files, to [$out]...\n" ) if ($dbg03); my $dbg04 = 0; # prt( "[dbg04] Excluded $exclude files, $dexclude by directory, $eexclude by extension...\n" ) if ($exclude && $dbg04); ### program variables my @warnings = (); my $cwd = cwd(); # my $block_size = 0; # stat($cwd)->blksize; # fails in WIN32 my @file_list = (); # final file list my $total_dirs = 0; # total direcotries scanned my $total_files = 0; my $total_size = 0; my $os = $^O; # forward references sub scan_directory($$); sub VERB1() { return ($verbosity > 0); } sub VERB2() { return ($verbosity > 1); } sub VERB3() { return ($verbosity > 2); } sub VERB4() { return ($verbosity > 3); } sub VERB5() { return ($verbosity > 4); } sub VERB6() { return ($verbosity > 5); } sub VERB7() { return ($verbosity > 6); } sub VERB8() { return ($verbosity > 7); } sub VERB9() { return ($verbosity > 8); } sub VERB10() { return ($verbosity > 9); } sub VERB11() { return ($verbosity > 10); } sub list_exclude_ext() { my ($ext,$wrap); if (@excluded_exts) { $wrap = 0; prt( " Default file extensions excluded are (not case sensitive) :-\n " ); foreach $ext (@excluded_exts) { prt( "$ext " ); $wrap++; if ($wrap > 15) { prt("\n "); $wrap = 0; } } prt("\n") if ($wrap); } } sub give_help() { prt( "$pgmname [options] directory\n" ); prt( "Options:\n" ); prt( " --help (-h or -?) = This help, and exit.\n" ); prt( " --out=<file> (-o) = Set the output file.\n" ); prt( " --dir=<dir> (-d) = Set directory (alternative way).\n" ); prt( " --add=<ext> (-a) = Add an excluded file extension.\n" ); prt( " --sub=<ext> (-s) = Subtract (remove) and excluded file extension.\n" ); list_exclude_ext(); prt( " --inc=<ext> (-i) = Include this, these extensions.\n" ); prt( " Note, if --inc:<ext> given, then ONLY these extensions are included.\n" ); prt( " --Remove (-R) = Remove ALL excluded file extensions.\n" ); prt( " --resursive (-r) = No recursive directory search.\n" ); prt( " --load (-l) = Load log at end.\n" ); prt( " --verb (-v) = Increase verbosity.\n" ); ###prt( " Using current directory ($cwd), if no directory given.\n" ); } sub show_warnings() { if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS...\n" ); foreach my $itm (@warnings) { prt("$itm\n"); } prt("\n"); } else { prt( "No warnings issued.\n" ) if (VERB5()); } } sub pgm_exit($$) { my ($val,$msg) = @_; show_warnings(); if ( (length($msg)) && (($val > 0)||(VERB2())) ) { $msg .= "\n" if (!($msg =~ /\n$/)); prt($msg); } ##prt("\n"); close_log($outfile,$load_log); exit($val); } sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } sub sub_root_dir($$) { my ($dir,$rt) = @_; my $len = length($rt); return $dir if (length($dir) < $len); my ($k); for ($k = 0; $k < $len; $k++) { last if (lc(substr($dir,$k,1)) ne lc(substr($rt,$k,1))); } return $dir if ($k < $len); $dir = substr($dir,$k); $dir = substr($dir,1) if ($dir =~ /^(\\|\/)/); return $dir; } sub scan_directory($$) { my ($ind, $lev) = @_; my (@fils,$fcnt,$fil,@dirs,$ff,$indd,$sfn); my ($sb,$tm,$sz); @dirs = (); if (opendir DIR, $ind) { $total_dirs++; @fils = readdir(DIR); closedir DIR; $fcnt = scalar @fils; prt( "Got $fcnt items from [$ind]... scanning...\n" ) if (VERB9()); $indd = $ind; $indd .= "\\" if (!($indd =~ /(\\|\/)$/)); foreach $fil (@fils) { next if (($fil eq '.')||($fil eq '..')); $ff = $indd.$fil; # ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($filename); # 0 1 2 3 4 5 6 7 8 # ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); $tm = 0; $sz = 0; if ($sb = stat($ff)) { $tm = $sb->mtime; $sz = $sb->size; } if (-d $ff) { push(@dirs,$ff); } else { $sfn = sub_root_dir($ff,$root_dir); ##if ($block_size == 0) { # FAILS IN WIN32 ## $block_size = $sb->blksize; ## prt( "Set block size to $block_size...\n" ); ##} push(@file_list,[ $sfn, $ff, $fil, $ind, $tm, $sz, 0 ]); $total_files++; $total_size += $sz; } } if ($recursive) { foreach $fil (@dirs) { scan_directory($fil, ($lev + 1)); } } } else { prtw("WARNING: Can not open directory [$ind]!\n"); } } sub path_2_dos($) { my ($d) = @_; $d =~ s/\//\\/g; return $d; } sub has_excluded_dir($) { my ($path) = @_; $path = path_2_dos($path); my @arr = split(/\\/,$path); foreach my $d (@arr) { if (defined $exclude_dirs{$d}) { return 1; } } return 0; } sub is_in_array_nc($$) { my ($itm, $rarr) = @_; $itm = lc($itm); foreach my $val (@{$rarr}) { $val = lc($val); if ($val eq $itm) { return 1; } } return 0; } sub get_nn($) { # perl nice number nicenum nice_num = add commas my ($n) = shift; if (length($n) > 3) { my $mod = length($n) % 3; my $ret = (($mod > 0) ? substr( $n, 0, $mod ) : ''); my $mx = int( length($n) / 3 ); for (my $i = 0; $i < $mx; $i++ ) { if (($mod == 0) && ($i == 0)) { $ret .= substr( $n, ($mod+(3*$i)), 3 ); } else { $ret .= ',' . substr( $n, ($mod+(3*$i)), 3 ); } } return $ret; } return $n; } # b2ks1 - bytes2ks bytestoks bytes_to_ks sub bytes2ks($) { my ($d) = @_; my $oss; my $kss; my $lg = 0; my $ks = ($d / 1024); #// get Ks my $div = 1; if( $ks < 1024 ) { $div = 1; $oss = "KB"; } elsif ( $ks < (1024*1024) ) { $div = 1024; $oss = "MB"; } elsif ( $ks < (1024*1024*1024) ) { $div = 1024*1024; $oss = "GB"; } else { $div = 1024*1024*1024; $oss = "TB"; } $kss = $ks / $div; $kss += 0.05; $kss *= 10; $lg = int($kss); return( ($lg / 10) . $oss ); } sub get_size_msg($) { my ($sz) = @_; return get_nn($sz)." (".bytes2ks($sz).")"; } sub got_includes() { my $cnt = scalar @include_exts; return $cnt; } sub is_in_includes($) { my ($ext) = @_; my $cnt = scalar @include_exts; if ($cnt) { if (is_in_array_nc($ext, \@include_exts)) { return 1; } else { return 0; } } return 1; # all are OK, if NO INCLUDES } sub out_file_list($) { my ($out) = @_; my ($cnt,$sfn,$ff,$fil,$ind,$i,$msg); my ($nm,$dr,$ex); my ($tm,$sz); $cnt = scalar @file_list; prt( "[dbg03] Out $cnt files, to [$out]...\n" ) if ($dbg03); $msg = ''; my $got_includes = got_includes(); # see if we have SPECIFIC INCLUDES my $dexclude = 0; my $eexclude = 0; my $iexclude = 0; my $exclude = 0; my $added = 0; my @dex = (); my @eex = (); my @iex = (); my $tsize = 0; for ($i = 0; $i < $cnt; $i++) { $sfn = $file_list[$i][0]; $ff = $file_list[$i][1]; $fil = $file_list[$i][2]; $ind = $file_list[$i][3]; $tm = $file_list[$i][4]; $sz = $file_list[$i][5]; ($nm, $dr, $ex) = fileparse( $fil, qr/\.[^.]*/ ); if ( has_excluded_dir($ind) ) { $dexclude++; push(@dex,$sfn); } elsif ($got_includes) { if (is_in_includes($ex) ) { $msg .= "$sfn\n"; $tsize += $sz; $added++; } else { $iexclude++; push(@iex,$sfn); } } else { # NOT excluded directory, and NO specific INCLUDES, then if ( is_in_array_nc($ex, \@excluded_exts) ) { $eexclude++; push(@eex,$sfn); } else { $msg .= "$sfn\n"; $tsize += $sz; $added++; } } } $exclude = $dexclude + $eexclude + $iexclude; $cnt -= $exclude; prt( "[dbg04] Excluded $exclude files, $dexclude by directory, $eexclude by extension, $iexclude not in includes...\n" ) if ($exclude && $dbg04); write2file($msg,$out); prt( "Scanned [$in_dir], list $cnt to [$out]... ".get_nn($tsize)." (".bytes2ks($tsize).") bytes...\n" ); prt( "\nWritten $added to [$out]...\n$msg"."List of $added written to [$out]\n") if (VERB2()); if (VERB9()) { if ($iexclude) { prt( "\nList of $iexclude excluded because NOT in INCLUDED extensions...\n" ); foreach $fil (@dex) { prt("$fil\n"); } prt( "Done list of $iexclude excluded because NOT in INCLUDED extensions...\n" ); } if ($dexclude) { prt( "\nList of $dexclude excluded by directory...\n" ); foreach $fil (@dex) { prt("$fil\n"); } prt( "Done list of $dexclude excluded by directory...\n" ); } if ($eexclude) { prt( "\nList of $eexclude excluded by extension...\n" ); foreach $fil (@eex) { prt("$fil\n"); } prt( "Done list of $eexclude excluded by extension...\n" ); } } } ######################################### ### MAIN ### prt( "[dbg01] $pgmname: in [$cwd]: Hello, World...\n" ) if ($dbg01); ### prt( "Current OS = [$os]\n" ); parse_args(@ARGV); scan_directory($in_dir,0); prt( "[dbg02] Scanned $total_dirs directories, for $total_files files, ".get_size_msg($total_size)." bytes...\n" ) if ($dbg02); out_file_list($out_file); pgm_exit(0,"Normal exit(0)"); ######################################## sub need_arg { my ($a, @b) = @_; if (! @b) { prt( "ERROR: Argument [$a] requires additional item!\n" ); pgm_exit(1,"Exit BAD command argument."); } } # parse arguments... not sure why this has to be AFTER MAIN... sub parse_args { my (@av) = @_; my $cnt = scalar @av; my ($arg,$sarg,$tmp,$act,$itm,$k,@arr); my ($lctmp,$lcitm,$msg); $msg = "Parsing $cnt arguments...\n"; $act = ''; while (@av) { $arg = $av[0]; $act = ''; if ($arg =~ /^(-|\/)/) { $sarg = substr($arg,1); if (($sarg =~ /\?/)||($sarg eq 'h')||($sarg eq '-help')) { give_help(); pgm_exit(0,"Exit after help"); } elsif ($sarg =~ /^-out(=|:)/) { $out_file = substr($sarg,5); $msg .= "Set out file to [$out_file]...\n"; } elsif ($sarg =~ /^o(=|:)/) { $out_file = substr($sarg,2); $msg .= "Set out file to [$out_file]...\n"; } elsif (($sarg eq 'o')||($sarg eq '-out')) { shift @av; need_arg($arg,@av); $out_file = $av[0]; $msg .= "Set out file to [$out_file]...\n"; } elsif ($sarg =~ /^-dir(=|:)/) { $in_dir = substr($sarg,5); $msg .= "Set in directory as [$in_dir]...\n"; } elsif ($sarg =~ /^d(=|:)/) { $in_dir = substr($sarg,2); $msg .= "Set in directory as [$in_dir]...\n"; } elsif (($sarg eq 'd')||($sarg eq '-dir')) { shift @av; need_arg($arg,@av); $in_dir = $av[0]; $msg .= "Set in directory as [$in_dir]...\n"; } elsif ($sarg =~ /^-add(=|:)/) { $tmp = substr($sarg,5); $act = 'a'; } elsif ($sarg =~ /^a(=|:)/) { $tmp = substr($sarg,2); $act = 'a'; } elsif (($sarg eq 'a')||($sarg eq '-add')) { shift @av; need_arg($arg,@av); $tmp = $av[0]; $act = 'a'; } elsif ($sarg =~ /^-sub(=|:)/) { $tmp = substr($sarg,5); $act = 's'; } elsif ($sarg =~ /^s(=|:)/) { $tmp = substr($sarg,2); $act = 's'; } elsif (($sarg eq 's')||($sarg eq '-sub')) { shift @av; need_arg($arg,@av); $tmp = $av[0]; $act = 's'; } elsif ($sarg =~ /^-inc(=|:)/) { $tmp = substr($sarg,5); $act = 'i'; } elsif ($sarg =~ /^i(=|:)/) { $tmp = substr($sarg,2); $act = 'i'; } elsif (($sarg eq 'i')||($sarg eq '-inc')) { shift @av; need_arg($arg,@av); $tmp = $av[0]; $act = 'i'; } elsif (($sarg eq 'R')||($sarg eq '-Remove')) { $cnt = scalar @excluded_exts; @excluded_exts = (); $msg .= "Removed ALL excluded extensions ($cnt to 0)\n"; } elsif ($sarg =~ /^r/) { $recursive = 0; } elsif ($sarg =~ /^v/) { # allow -vvvvv, and -v9... while ($sarg =~ /^v/) { $verbosity++; $sarg = substr($sarg,1); } if (length($sarg)) { if ($sarg =~ /^\d+$/) { $verbosity = $sarg; $msg .= "Set verbosity to $verbosity...\n"; } else { prt( "ERROR: Unknown argument [$arg]!\n" ); pgm_exit(1,"Exit BAD command argument."); } } else { $msg .= "Increased verbosity to $verbosity...\n"; } } elsif ($sarg =~ /^-verb/) { $verbosity++; $msg .= "Increased verbosity to [$verbosity]...\n"; } elsif (($sarg eq 'l')||($sarg eq '-load')) { $load_log = 1; $msg .= "Set load log at end...\n"; } else { prt( "ERROR: Unknown argument [$arg]!\n" ); pgm_exit(1,"Exit BAD command argument."); } } else { $in_dir = $arg; $msg .= "Set root directory as [$in_dir]...\n"; } # =================================================== # post actions, if any # add an extension if ($act eq 'a') { $msg .= "Adding excluded extension [$tmp]... "; $cnt = scalar @excluded_exts; $lctmp = lc($tmp); for ($k = 0; $k < $cnt; $k++) { $itm = $excluded_exts[$k]; $lcitm = lc($itm); last if ($lcitm eq $lctmp); } if ($k < $cnt) { $msg .= "already there!\n"; } else { push(@excluded_exts,$tmp); $cnt = scalar @excluded_exts; $msg .= "ok ($cnt)\n"; } $act = ''; } elsif ($act eq 's') { # sub an extension $msg .= "Subbing excluded extension [$tmp]... "; $cnt = scalar @excluded_exts; @arr = (); $lctmp = lc($tmp); for ($k = 0; $k < $cnt; $k++) { $itm = $excluded_exts[$k]; $lcitm = lc($itm); if ($lcitm eq $lctmp) { $act = 'ok'; } else { push(@arr,$itm); } } if ($act eq 'ok') { $msg .= "ok.\n"; @excluded_exts = @arr; } else { prt("ERROR: Extension [$tmp] NOT IN LIST!\n"); pgm_exit(1,"Exit BAD command argument."); } $act = ''; } elsif ($act eq 'i') { push(@include_exts,$tmp); $cnt = scalar @include_exts; $msg .= "Added [$tmp] to INCLUDE extensions ($cnt)\n"; $act = ''; } # =========================== shift @av; # move to NEXT # =========================== } if (length($in_dir) == 0) { pgm_exit(1,"Error: No input directory given!"); } if (! -d $in_dir) { pgm_exit(1,"Error: Can NOT stat input directory $in_dir!"); } # post processing ($arg,$root_dir) = fileparse($in_dir); $msg .= "Set root_dir=[$root_dir] (nm=$arg)\n" ; prt( $msg ) if (VERB5()); } # eof - filelist.pl