#!/usr/bin/perl -w
# NAME: listlibs.pl
# AIM: Given an input directory, list the *.lib found. Do not duplicate if 'name.lib' and 'named.lib'
# 09/05/2020 - Review
# 29/08/2012 - Add -R
to show list relative to this directory
# 04/11/2011 - Add -F FULL, and -f full - CWD
# 25/10/2011 - Add option to include *.pdb
# 14/09/2011 geoff mclane http://geoffair.net/mperl
use strict;
use warnings;
use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] )
use File::Spec; # File::Spec->rel2abs($rel); # get ABSOLUTE PATH form
use File::stat; # to get the file date and size
use Cwd;
my $perl_dir = 'C:\GTools\perl';
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 = $perl_dir."\\temp.$pgmname.txt";
open_log($outfile);
# user variables
my $VERS = "0.0.2 2020-05-09";
###my $VERS = "0.0.1 2011-09-14";
my $load_log = 0;
my $verbosity = 0;
my $recursive = 0;
my $full_path = 0;
my $show_debug = 0;
my $show_debug_only = 0;
my $add_pdb = 0;
my $out_file = '';
my $show_short_form = 1;
my $rel_dir = '';
my $debug_on = 0;
my $def_rel = 'C:\FG\16';
my $def_file = $def_rel.'\3rdParty\lib';
###my $def_file = 'C:\Projects\OSG\OSG-3.0.1\lib';
my $def_out = $perl_dir."\\templist.txt";
### program variables
my @warnings = ();
my $cwd = cwd();
my $os = $^O;
my $in_file = '';
my @file_list = ();
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" );
}
}
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 is_my_type($) {
my $fil = shift;
my ($name,$dir,$ext) = fileparse($fil, qr/\.[^.]*/ );
return 1 if ($ext =~ /^\.lib$/i);
return 1 if ($ext =~ /^\.pdb$/i);
return 0;
}
sub process_in_dir($$);
sub get_short_form($$) {
my ($fil1,$fil2) = @_;
my $len1 = length($fil1);
my $len2 = length($fil2);
if ($len1 > $len2) {
my ($ch1,$ch2,$i);
for ($i = 0; $i < $len2; $i++) {
$ch1 = substr($fil1,$i,1);
$ch2 = substr($fil2,$i,1);
last if ($ch1 ne $ch2);
}
$fil1 = substr($fil1,$i);
$fil1 =~ s/^(\\|\/)//;
#prt("Lengths fil1=$len1 and fil2=$len2 - return $fil1\n");
} else {
##prt("Lengths fil1=$len1 and fil2=$len2\n");
}
return $fil1;
}
sub sub_base_dir($) {
my $fil1 = shift;
my $fil2 = $in_file;
return get_short_form($fil1,$fil2);
}
sub sub_current_directory($) {
my $fil1 = shift;
my $fil2 = path_u2d($cwd);
return get_short_form($fil1,$fil2);
}
sub sub_rel_directory($$) {
my ($fil1,$fil2) = @_;
return get_short_form($fil1,$fil2);
}
sub list_files($) {
my $ra = shift; # = \@file_list
my $cnt = scalar @{$ra};
prt("Found $cnt files of type...\n");
my %names = ();
my @new_list = ();
my @dbg_list = ();
my ($nm,$dr,$ex,$ff,$nm2,$i,$sf,$sz,$sb,$total,$nn,$gtot,$dout);
foreach $ff (@{$ra}) {
($nm,$dr,$ex) = fileparse($ff, qr/\.[^.]*/ );
# $names{$nm} = 1;
$names{$nm} = 1 if ($ex =~ /^\.lib$/i); # add the LIB names
}
foreach $ff (@{$ra}) {
($nm,$dr,$ex) = fileparse($ff, qr/\.[^.]*/ );
$sf = sub_base_dir($ff);
if ($ex =~ /^\.pdb$/) {
push(@dbg_list,[$sf,$ff]) if (defined $names{$nm}); # add DEBUG only if 'name' exists
next;
} elsif ($nm =~ /_d$/i) {
$nm2 = $nm;
$nm2 =~ s/_d$//i;
if (defined $names{$nm2}) {
push(@dbg_list,[$sf,$ff]);
next;
}
} elsif ($nm =~ /d$/i) {
$nm2 = $nm;
$nm2 =~ s/d$//i;
if (defined $names{$nm2}) {
push(@dbg_list,[$sf,$ff]);
next;
}
}
prt("$sf\n") if (VERB9());
push(@new_list,[$sf,$ff]);
}
my $ncnt = scalar @new_list;
my $dcnt = scalar @dbg_list;
my $msg = '';
my $out = (length($out_file)) ? 0 : 1;
prt("Release List $ncnt libraries, $dcnt debug form...\n");
$total = 0;
if (!$show_debug_only) {
for ($i = 0; $i < $ncnt; $i++) {
$sf = $new_list[$i][0];
$ff = $new_list[$i][1];
$sz = 0;
if ($sb = stat($ff)) {
$sz = $sb->size;
}
$total += $sz;
if ($show_short_form) {
if (length($rel_dir)) {
$ff = sub_rel_directory($ff,$rel_dir);
} else {
$ff = sub_current_directory($ff);
}
}
if ($full_path) {
prt("$ff\n") if ($out);
$msg .= "$ff\n";
} else {
prt("$sf\n") if ($out);
$msg .= "$sf\n";
}
}
$gtot = $total;
if ($total > 100000) {
$nn = util_bytes2ks($total);
$nn .= " (".get_nn($total)." bytes)";
} else {
$nn = get_nn($total).' bytes';
}
prt("Done Release list $ncnt libraries... total $nn...\n") if ($ncnt);
}
if ($dcnt && $show_debug) {
prt("Debug List - up to $dcnt libraries...\n");
$total = 0;
$dout = 0;
for ($i = 0; $i < $dcnt; $i++) {
$sf = $dbg_list[$i][0];
$ff = $dbg_list[$i][1];
if (!$add_pdb) {
next if ($sf =~ /\.pdb$/i);
}
$dout++;
$sz = 0;
if ($sb = stat($ff)) {
$sz = $sb->size;
}
$total += $sz;
if ($show_short_form) {
if (length($rel_dir)) {
$ff = sub_rel_directory($ff,$rel_dir);
} else {
$ff = sub_current_directory($ff);
}
}
if ($full_path) {
prt("$ff\n") if ($out);
$msg .= "$ff\n";
} else {
prt("$sf\n") if ($out);
$msg .= "$sf\n";
}
}
$gtot += $total;
if ($total > 100000) {
$nn = util_bytes2ks($total);
$nn .= " (".get_nn($total)." bytes)";
} else {
$nn = get_nn($total).' bytes';
}
prt("Done Debug list $dout libraries... total $nn...\n");
if ($gtot > 100000) {
$nn = util_bytes2ks($gtot);
$nn .= " (".get_nn($gtot)." bytes)";
} else {
$nn = get_nn($gtot).' bytes';
}
prt("Grand total $nn\n");
}
if (length($out_file)) {
write2file($msg,$out_file);
prt("Written list to [$out_file]\n");
}
}
sub process_in_dir($$) {
my ($dir,$lev) = @_;
my $lib = '';
if (opendir(DIR,$dir)) {
my @files = readdir(DIR);
closedir(DIR);
my $cnt = scalar @files;
prt("Found $cnt items in [$dir]\n") if (VERB5());
my ($file,$ff);
my @dirs = ();
$dir .= "\\" if ( !($dir =~ /(\\|\/)$/) );
foreach $file (@files) {
next if (($file eq '.')||($file eq '..'));
$ff = $dir.$file;
if (-f $ff) {
prt("$file\n") if (VERB9());
push(@file_list,$ff) if (is_my_type($file));
} elsif (-d $ff) {
if ($recursive) {
push(@dirs,$ff);
} else {
if ($file =~ /^lib$/i) {
$lib = $ff;
} else {
push(@dirs,$ff);
}
}
} else {
# quietly ignore
}
}
if (length($lib)) {
process_in_dir($lib,$lev+1);
}
if ($recursive && @dirs) {
foreach $ff (@dirs) {
process_in_dir($ff,$lev+1);
}
}
if ($lev == 0) {
list_files(\@file_list);
}
} else {
prt("ERROR: Unable to open directory [$dir]!\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);
###prt( "$pgmname: in [$cwd]: Hello, World...\n" );
process_in_dir($in_file,0);
pgm_exit(0,"");
########################################
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(" --debug (-d) = Also show DEBUG list.\n");
prt(" --DEBUG (-D) = Only output the DEBUG list of libraries.\n");
prt(" --Full (-F) = Show FULL qualified path.\n");
prt(" --full (-f) = Show full path minus CWD, REL directory if given.\n");
prt(" --loadlog (-l) = Load LOG file at end.\n");
prt(" --out (-o) = Write list to output file.\n");
prt(" --pdb (-p) = Include program database files (*.pdb). Implies -d debug list.\n");
prt(" --recursive (-r) = Recursively process sub-directories.\n");
prt(" --REL (-R) = Show list releative to this directory.\n");
prt(" --verb[n] (-v) = Bump [or set] verbosity. def=$verbosity\n");
}
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 =~ /^d/) {
$show_debug = 1;
prt("Set to show DEBUG libraries also.\n") if (VERB1());
} elsif ($sarg =~ /^D/) {
$show_debug = 1;
$show_debug_only = 1;
prt("Set to show DEBUG libraries only.\n") if (VERB1());
} elsif ($sarg =~ /^F/) {
$full_path = 1;
$show_short_form = 0;
prt("Set to show FULL PATH.\n") if (VERB1());
} elsif ($sarg =~ /^f/) {
$full_path = 1;
prt("Set to show full PATH excluding CWD.\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 to output list file to $out_file.\n") if (VERB1());
} elsif ($sarg =~ /^p/) {
$show_debug = 1;
$add_pdb = 1;
prt("Set to show DEBUG libraries and *.pdb also.\n") if (VERB1());
} elsif ($sarg =~ /^R/) {
need_arg(@av);
shift @av;
$sarg = $av[0];
$rel_dir = path_u2d($sarg);
prt("Set to show relative to this directory $rel_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 =~ /^r/) {
$recursive = 1;
prt("Set resursive into sub-directories.\n") if (VERB1());
} else {
pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n");
}
} else {
$in_file = File::Spec->rel2abs($arg);
prt("Set input to [$in_file]\n") if (VERB1());
}
shift @av;
}
if ((length($in_file) == 0) && $debug_on) {
$in_file = $def_file;
###$recursive = 1;
$rel_dir = $def_rel;
###$show_short_form = 0;
$full_path = 1;
$out_file = $def_out;
$show_debug = 1;
$show_debug_only = 1;
}
if (length($in_file) == 0) {
pgm_exit(1,"ERROR: No input directory found in command!\n");
}
if (! -d $in_file) {
pgm_exit(1,"ERROR: Unable to find in directory [$in_file]! Check name, location...\n");
}
if ($full_path) {
$in_file = File::Spec->rel2abs($in_file);
}
}
# eof - template.pl