#!/usr/bin/perl -w # NAME: ziplist.pl # AIM: Given a FOLDER, prepare a zip-list file, listing all ready for ZIPPING, # but excluding certain files, per options # 29/03/2012 - Initial cut use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use File::stat; # get file info if ($sb = stat($fil)){$dt = $sb->mtime; $sz = $sb->size;} use Cwd; my $os = $^O; my $perl_dir = '/home/geoff/bin'; my $PATH_SEP = '/'; my $temp_dir = '/tmp'; my $is_os_win = ($os =~ /win/i) ? 1 : 0; if ($is_os_win) { $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 2012-03-29"; my $load_log = 0; my $in_directory = ''; my $verbosity = 0; my $out_file = ''; my $base_dir = ''; my $debug_on = 0; my $def_base = 'C:\Projects\patch\patch-2.5.9'; my $def_dir = 'C:\Projects\patch\patch-2.5.9'; my @excluded_files = qw( mt.dep BuildLog.htm ); my @excluded_exts = qw(.old .bak .obj .err .pdb .lst .pch .ilk .NCB .plg .OPT .idb .aps .sbr .suo .exp .bsc .manifest .user .res .sdf .opensdf .tlog .ipch .zip .exe .lib .dll .exp ); my @excluded_dirs = qw( Debug Release ipch autom4te.cache ); ### program variables my @warnings = (); my $cwd = cwd(); my $total_links = 0; my $total_files = 0; my $total_dirs = 0; my $total_excluded = 0; my @file_list = (); sub scan_directory($$$); 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); } my $IS_TEMP = 1; my $IS_FILE = 2; my $IS_EXT = 3; my $IS_DIR = 4; my %ex_hash = ( $IS_TEMP => "temp file", $IS_FILE => "excl file", $IS_EXT => "excl ext", $IS_DIR => "excl dir" ); sub get_ex_stg($) { my $ex = shift; if (defined $ex_hash{$ex}) { return $ex_hash{$ex}; } return "Unknown $ex"; } sub has_excluded_ext($) { my $file = shift; my ($n,$d,$e) = fileparse($file, qr/\.[^.]*/); my ($ext); if ($is_os_win) { $e = lc($e); foreach $ext (@excluded_exts) { $ext = lc($ext); return $IS_EXT if ($e eq $ext); } } else { foreach $ext (@excluded_exts) { return $IS_EXT if ($e eq $ext); } } return 0; } sub is_excluded_file($) { my $file = shift; my ($n,$d) = fileparse($file); my ($fil); foreach $fil (@excluded_files) { return $IS_FILE if ($n eq $fil); if ($is_os_win) { return $IS_FILE if ($n =~ /^$fil$/i); } } return 0; } sub is_temp_file($) { my $file = shift; my ($n,$d) = fileparse($file); return 0 if ($n =~ /^template/i); return $IS_TEMP if ($n =~ /^temp/i); return 0; } sub in_excluded_dir($) { my $path = shift; if ($is_os_win) { $path = path_u2d($path); } else { $path = path_d2u($path); } my ($n,$d) = fileparse($path); my @dirs = (); # split("$PATH_SEP",$d); my ($dir,$tst); if ($is_os_win) { @dirs = split(/\\/,$d); foreach $dir (@dirs) { $dir = lc($dir); foreach $tst (@excluded_dirs) { $tst = lc($tst); return $IS_DIR if ($dir eq $tst); } } } else { @dirs = split(/\//,$d); foreach $dir (@dirs) { foreach $tst (@excluded_dirs) { return $IS_DIR if ($dir eq $tst); } } } } sub remove_base_path($$) { my ($ln, $bs) = @_; my $len1 = length($ln); my $len2 = length($bs); if ($len1 < $len2) { return $ln; } my ($i,$c1,$c2); for ($i = 0; $i < $len2; $i++) { $c1 = lc(substr($ln,$i,1)); $c2 = lc(substr($bs,$i,1)); if ($c1 ne $c2) { return $ln; } } return substr($ln,$len2); } sub remove_base_dir($) { my $ff = shift; my $bs = $base_dir; $bs .= $PATH_SEP if ( !($bs =~ /(\\|\/)$/) ); return remove_base_path($ff,$bs); } sub scan_directory($$$) { my ($dir,$lev,$ra) = @_; my @dirs = (); if (!opendir(DIR,$dir)) { prtw("WARNING: Unable to open directory [$dir]!\n"); return; } $total_dirs++; my @files = readdir(DIR); closedir(DIR); my ($ff,$file,$sb,$dt,$sz,$ex); $dir .= $PATH_SEP if (!($dir =~ /(\\|\/)$/)); foreach $file (@files) { next if ($file eq '.'); next if ($file eq '..'); $ff = $dir.$file; if (-l $ff) { $total_links++; } elsif (-d $ff) { push(@dirs,$ff); } elsif (-f $ff) { if ($sb = stat($ff)) { $dt = $sb->mtime; $sz = $sb->size; } else { $dt = 0; $sz = 0; prtw("WARNING: Unable to 'stat' file [$ff]!\n"); } $ex = is_temp_file($file); if (!$ex) { $ex = is_excluded_file($file); if (!$ex) { $ex = has_excluded_ext($file); if (!$ex) { $ex = in_excluded_dir($ff); } } } $total_excluded++ if ($ex); push(@{$ra},[$file,$ff,$dt,$sz,$ex]); $total_files++; } else { prtw("WARNING: WHAT IS THIS [$ff] NOT LINK, DIRECTORY OR FILE!\n"); } } if (@dirs) { foreach $ff (@dirs) { scan_directory($ff,($lev+1),$ra); } } if ($lev == 0) { my $msg = "Beginning at [$dir], "; $msg .= "\nscanned $total_dirs directories, found $total_files files"; $msg .= ", $total_links links" if ($total_links); $sz = $total_files - $total_excluded; $msg .= ", $total_excluded excluded, leaving $sz files" if ($total_excluded); prt("$msg\n"); if (length($out_file) == 0) { $out_file = $temp_dir.$PATH_SEP."tempziplist.txt"; } my $cnt = scalar @{$ra}; my ($i,$txt,$min); my $rembase = (length($base_dir) ? 1 : 0); $txt = ''; $file = $temp_dir.$PATH_SEP."tempzipexcluded.txt"; $min = 0; for ($i = 0; $i < $cnt; $i++) { # 0 1 2 3 4 #push(@{$ra},[$file,$ff,$dt,$sz,$ex]); $ff = ${$ra}[$i][1]; $ex = ${$ra}[$i][4]; if ($ex) { $sz = length($ff); $min = $sz if ($sz > $min); } } for ($i = 0; $i < $cnt; $i++) { # 0 1 2 3 4 #push(@{$ra},[$file,$ff,$dt,$sz,$ex]); $ff = ${$ra}[$i][1]; $ex = ${$ra}[$i][4]; if ($ex) { $ff .= ' ' while (length($ff) < $min); $txt .= "$ff "; $txt .= get_ex_stg($ex); $txt .= "\n"; } } write2file($txt,$file); prt("EXCLUDED list written to [$file]\n"); $txt = ''; for ($i = 0; $i < $cnt; $i++) { # 0 1 2 3 4 #push(@{$ra},[$file,$ff,$dt,$sz,$ex]); $ff = ${$ra}[$i][1]; $dt = ${$ra}[$i][2]; $sz = ${$ra}[$i][3]; $ex = ${$ra}[$i][4]; if (!$ex) { $ff = remove_base_dir($ff) if ($rembase); $txt .= "$ff\n"; } } write2file($txt,$out_file); prt("List written to [$out_file]\n"); } } sub process_in_file($) { my ($inf) = @_; if (! open INF, "<$inf") { pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); } my @lines = ; 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"); } } } ######################################### ### MAIN ### parse_args(@ARGV); #process_in_file($in_directory); scan_directory($in_directory,0,\@file_list); 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 =~ /^b/) { need_arg(@av); shift @av; $sarg = $av[0]; $base_dir = $sarg; $base_dir .= $PATH_SEP if ( !($base_dir =~ /(\\|\/)$/) ); prt("Set base directory to [$base_dir].\n") if (VERB1()); } 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/) { $load_log = 1; prt("Set to load log at end.\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_directory = $arg; prt("Set input to [$in_directory]\n") if (VERB1()); } shift @av; } if ((length($in_directory) == 0) && $debug_on) { $in_directory = $def_dir; prt("Set DEFAULT input to [$in_directory]\n"); $base_dir = $def_base; } if (length($in_directory) == 0) { pgm_exit(1,"ERROR: No input directory found in command!\n"); } if (! -d $in_directory) { pgm_exit(1,"ERROR: Unable to find directory [$in_directory]! 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(" --base (-b) = Delete this base from file names.\n"); prt(" --load (-l) = Load LOG at end. ($outfile)\n"); prt(" --out (-o) = Write output to this file.\n"); } # eof - ziplist.pl