#!/usr/bin/perl -w # NAME: showprojs.pl # AIM: Given a root directory, search one level down for a CMakeLists.txt, and extract project name # Skip folders that start with 'build...', and with no CMakeLists.txt # 03/12/2014 - Add script name to output # 04/09/2014 - Initial cut use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use File::stat; 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.4 2014-12-03"; ##my $VERS = "0.0.3 2014-09-04"; ###my $VERS = "0.0.2 2014-01-13"; my $load_log = 0; my $in_dir = ''; my $verbosity = 0; my $out_file = $temp_dir.$PATH_SEP."tempprojs.txt"; # ### DEBUG ### my $debug_on = 0; my $def_file = 'F:\Projects'; ### 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); } # process a CMakeLists.txt, looking for 'project( NAME )' sub process_cm_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") if (VERB9()); my ($line,$inc,$lnn,@arr); $lnn = 0; foreach $line (@lines) { chomp $line; $lnn++; if ($line =~ /^\s*project\s*\(\s*(.+)\s*\)/i) { $inc = $1; @arr = split(/\s+/,$inc); $inc = $arr[0]; prt("$lnn: $inc\n") if (VERB5()); return $inc; } } return ""; } # known directories to EXCLUDE my %excluded_dirs = ( ".git" => 1, "3rdParty" => 1, "3rdParty.x64" => 1, "artifacts" => 1, "boost_1_53_0" => 1, "fgdata" => 1, "fgsvnts" => 1, "install" => 1, "scripts" => 1, "temp" => 1, "zips" => 1, "terragear.old" => 1, "flightgear.old" => 1, "tests" => 1, ); my @fix_upd = (); my @fix_bm = (); my %subs = ( 'TIME' => 'time', 'DATE' => 'date', 'CD' => 'pwd', 'DOWNLOADS' => 'download', 'PROCESSOR_ARCHITECTURE' => 'AMD64' ); my $act_line = ''; my $act_lnn = 0; my $act_inf = ''; sub do_split_subs($$) { my ($line,$ra) = @_; my $len = length($line); my ($i,$ch,$tag); $tag = ''; #prt("Splitting '$line' on \% sign...\n") if (VERB9()); my @arr = (); for ($i = 0; $i < $len; $i++) { $ch = substr($line,$i,1); if ($ch eq '%') { push(@arr,$tag) if (length($tag)); $tag = $ch; # add first char $i++; for (; $i < $len; $i++) { $ch = substr($line,$i,1); $tag .= $ch; last if ($ch eq '%'); } push(@arr,$tag) if (length($tag)); $tag = ''; # clear the tag } else { $tag .= $ch; } } push(@arr,$tag) if (length($tag)); $len = scalar @arr; #prt("Split in $len '".join(" ",@arr)."\n") if (VERB9()); @{$ra} = @arr; } sub do_subs($) { my $rinc = shift; my $inc = ${$rinc}; ###my @arr = split(/\\/,$inc); my @arr = (); do_split_subs($inc,\@arr); my $cnt = scalar @arr; my ($i,$val,$sub,$rep); for ($i = 0; $i < $cnt; $i++) { $val = $arr[$i]; if ($val =~ /\%(\w+)\%/) { $sub = $1; if (defined $subs{$sub}) { $rep = $subs{$sub}; $val =~ s/\%(\w+)\%/$rep/; $arr[$i] = $val; } else { @arr = sort keys %subs; prt("Have subs [".join(" ",@arr)."\n"); pgm_exit(1,"ERROR: $act_lnn: [$act_line] No SUB for [$sub] in $act_inf\n"); } } } $val = ''; for ($i = 0; $i < $cnt; $i++) { $val .= $arr[$i]; } if ($inc ne $val) { ${$rinc} = $val; return 1; } return 0; } # process the 'standard' build-me.bat file sub process_bm_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") if (VERB9()); my ($line,$inc,$lnn,@arr,$var,$val,$sub,$rep,$msg,$tmp); $lnn = 0; foreach $line (@lines) { chomp $line; $line = trim_all($line); $lnn++; next if ($line =~ /^\@*REM/i); if ($line =~ /TMPSRC=(.+)$/) { $inc = $1; prt("$lnn: bm file TMPSRC=$inc ") if (VERB5()); $val = $inc; $act_line = $line; $act_lnn = $lnn; $act_inf = $inf; if (do_subs(\$inc)) { prt("After subs $val changed to $inc ") if (VERB5()); $val = $inc; } prt("\n") if (VERB5()); return $val; } elsif ($line =~ /set\s+(\w+)=(.+)$/) { $var = $1; $val = $2; $act_line = $line; $act_lnn = $lnn; $act_inf = $inf; do_subs(\$val); $msg = 'Added'; if (defined $subs{$var}) { $tmp = $subs{$var}; $msg = "Replaced val '$tmp'"; } prt("$msg subs key $var, value $val\n") if (VERB9()); $subs{$var} = $val; } elsif ($line =~ /set\s+(\w+)=$/) { $var = $1; $msg = 'Added'; if (defined $subs{$var}) { $tmp = $subs{$var}; $msg = "Replaced val '$tmp'"; } prt("$msg to subs key $var, with no value\n") if (VERB9()); $subs{$var} = ""; } } prtw("WARNING: TMPSRC not found in $inf\n"); push(@fix_bm,$inf); return ""; } sub process_bat_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") if (VERB9()); my ($line,$inc,$lnn,@arr,$var,$val,$sub,$rep); $lnn = 0; foreach $line (@lines) { chomp $line; $line = trim_all($line); $lnn++; next if ($line =~ /^\@*REM/i); next if ($line =~ /^\@*echo/i); next if ($line =~ /^\@*setlocal/i); next if ($line =~ /^:/); next if ($line =~ /^\@*endlocal/i); next if ($line =~ /^\@*exit/i); next if ($line =~ /^\@*goto/i); if ($line =~ /TMPDIR=(.+)$/) { $inc = $1; prt("$lnn: $inc\n") if (VERB5()); $val = $inc; while ($val =~ /\%(\w+)\%/) { $sub = $1; if (defined $subs{$sub}) { $rep = $subs{$sub}; $val =~ s/\%(\w+)\%/$rep/; } else { @arr = sort keys %subs; prt("Have subs [".join(" ",@arr)."\n"); pgm_exit(1,"ERROR: $lnn: [$line] No SUB for [$sub] in $inf\n"); } } return $val; } elsif ($line =~ /set\s+(\w+)=(.+)$/) { $var = $1; $val = $2; while ($val =~ /\%(\w+)\%/) { $sub = $1; if (defined $subs{$sub}) { $rep = $subs{$sub}; $val =~ s/\%(\w+)\%/$rep/; } else { @arr = sort keys %subs; prt("Have subs [".join(" ",@arr)."\n"); pgm_exit(1,"ERROR: $lnn: [$line] No SUB for [$sub] in $inf\n"); } } $subs{$var} = $val; } elsif ($line =~ /set\s+(\w+)=$/) { $var = $1; $subs{$var} = ""; } } prtw("WARNING: TMPDIR not found in $inf\n"); push(@fix_upd,$inf); return ""; } # put least first sub mycmp_ascend_n3 { if (${$a}[3] < ${$b}[3]) { return -1; } if (${$a}[3] > ${$b}[3]) { return 1; } return 0; } # escape each of these '^ $ . | { } [ ] ( ) * + ? \ ' sub escape_regex($) { my $txt = shift; my $len = length($txt); my ($i,$c); my $ntxt = ''; for ($i = 0; $i < $len; $i++) { $c = substr($txt,$i,1); if ($c eq '^') { $ntxt .= '\\'; } elsif ($c eq '$') { $ntxt .= '\\'; } elsif ($c eq '|') { $ntxt .= '\\'; } elsif ($c eq '{') { $ntxt .= '\\'; } elsif ($c eq '}') { $ntxt .= '\\'; } elsif ($c eq '[') { $ntxt .= '\\'; } elsif ($c eq ']') { $ntxt .= '\\'; } elsif ($c eq '(') { $ntxt .= '\\'; } elsif ($c eq ')') { $ntxt .= '\\'; } elsif ($c eq '*') { $ntxt .= '\\'; } elsif ($c eq '+') { $ntxt .= '\\'; } elsif ($c eq '?') { $ntxt .= '\\'; } elsif ($c eq '\\') { $ntxt .= '\\'; } $ntxt .= $c; } return $ntxt; } sub is_bat_file($) { my $bat = shift; return 1 if ($bat =~ /\.bat$/i); return 0; } sub process_in_dir($$) { my ($dir,$lev) = @_; if (!opendir(DIR,$dir)) { prtw("WARNING: Failed to open directory $dir!\n"); return; } my @files = readdir(DIR); closedir(DIR); my ($file,$ff,$cnt,$cmf,$ra,$proj,$time,$size,$len,$max,$max2,$asiz,$atim,$acnt,$sb); my ($bmf,$src,$maxb); my $txt = ''; my $msg = ''; my ($bms,$ra2,$bmd,$bmsg,$n,$d); my ($lcnm,$lcdir,$ok,@arr); my %matched = (); $cnt = scalar @files; prt("Found $cnt items in $dir...\n"); ut_fix_directory(\$dir); my @dirs = (); my @builds = (); my @nocmake = (); my @nobldme = (); my @updbats = (); $max = 0; $max2 = 0; $maxb = 0; foreach $file (@files) { next if ($file eq '.'); next if ($file eq '..'); $ff = $dir.$file; if (-f $ff) { # skip files - could also match the upd....bat to the src if (is_bat_file($file)) { if ($file =~ /^upd(\w+)\./i) { $src = process_bat_file($ff); } } } elsif (-d $ff) { if (defined $excluded_dirs{$file}) { # deliberately SKIP these 'known' directories ############################################# } elsif ($file =~ /^build\-/) { $bmf = $ff.$PATH_SEP.'build-me.bat'; if (-f $bmf) { $src = process_bm_file($bmf); $time = 0; $size = 0; if ($sb = stat($cmf)) { $time = $sb->mtime; $size = $sb->size; } # 0 1 2 3 4 5 push(@builds,[$ff,$bmf,$file,$time,$size,$src]); $len = length($file); # is a directory $maxb = $len if ($len > $maxb); } else { push(@nobldme,$file); } # } elsif ($file =~ /^boost/) { # # exception for boost - uses bootstrap.bat # $cmf = $ff.$PATH_SEP.'bootsrap.bat'; # if (-f $cmf) { # $time = 0; # $size = 0; # if ($sb = stat($cmf)) { # $time = $sb->mtime; # $size = $sb->size; # } # $len = length($file); # $max = $len if ($len > $max); # $proj = 'boost'; # process_cm_file($cmf); # $len = length($proj); # $max2 = $len if ($len > $max2); # # 0 1 2 3 4 5 # push(@dirs,[$ff,$cmf,$file,$time,$size,$proj]); # } else { # push(@nocmake,$file); # } } else { $cmf = $ff.$PATH_SEP.'CMakeLists.txt'; if (-f $cmf) { $time = 0; $size = 0; if ($sb = stat($cmf)) { $time = $sb->mtime; $size = $sb->size; } $len = length($file); $max = $len if ($len > $max); $proj = process_cm_file($cmf); $len = length($proj); $max2 = $len if ($len > $max2); # 0 1 2 3 4 5 push(@dirs,[$ff,$cmf,$file,$time,$size,$proj]); } else { push(@nocmake,$file); } } } else { prtw("WARNING: What is this [$ff]?\n"); } } $cnt = scalar @nobldme; if ($cnt) { prt("Found $cnt build-... folders with no 'build-me.bat' file\n"); prt(join(" ",@nobldme)."\n"); } $cnt = scalar @nocmake; if ($cnt) { prt("Found $cnt folders with no 'CMakeLists.txt' file\n"); prt(join(" ",@nocmake)."\n"); } $atim = lu_get_YYYYMMDD_hhmmss(time()); $msg = "Project list updated by $pgmname on $atim\n"; prt($msg); $txt .= $msg; $cnt = scalar @builds; $msg = "Found $cnt 'build' directories...\n"; prt($msg); $txt .= $msg; if (VERB2()) { $cnt = 0; foreach $ra2 (@builds) { $bmd = ${$ra2}[2]; $bms = ${$ra2}[5]; $cnt++; $acnt = sprintf("%2u",$cnt); $bmd .= ' ' while (length($bmd) < $maxb); prt("$acnt $bmd $bms\n"); } } @dirs = sort mycmp_ascend_n3 @dirs; $cnt = scalar @dirs; $msg = "Found $cnt suitable source directories...\n"; prt($msg); $txt .= $msg; $cnt = 0; foreach $ra (@dirs) { $cnt++; $ff = ${$ra}[0]; $cmf = ${$ra}[1]; $file = ${$ra}[2]; # ACTUALLY IS A DIRECTORY $time = ${$ra}[3]; $size = ${$ra}[4]; $proj = ${$ra}[5]; my @bms = (); $lcdir = lc($file); foreach $ra2 (@builds) { $bmd = ${$ra2}[2]; $bms = ${$ra2}[5]; ($n,$d) = fileparse($bms); $lcnm = lc($n); $bms = escape_regex($bms); $ok = 0; if ($lcdir eq $lcnm) { $ok = 1; } elsif ($file =~ /$bms/) { $ok = 1; } if ($ok) { $matched{$bmd} = 1; push(@bms,$bmd); } } $bmsg = ''; if (@bms) { $bmsg = 'builds: '.join(", ",@bms); } $file .= ' ' while (length($file) < $max); $proj .= ' ' while (length($proj) < $max2); $atim = lu_get_YYYYMMDD_hhmmss($time); $asiz = sprintf("%7u",$size); $acnt = sprintf("%2u",$cnt); $msg = "$acnt: $proj $file $atim $asiz $bmsg\n"; prt($msg); $txt .= $msg; } @arr = (); my ($i,$j); $cnt = scalar @builds; for ($i = 0; $i < $cnt; $i++) { $ra2 = $builds[$i]; $bmd = ${$ra2}[2]; if (!defined $matched{$bmd}) { push(@arr,$i); } } $cnt = scalar @arr; if ($cnt) { # $msg = "Unmatched $cnt build dirs [".join(" ",@arr)."]\n"; $msg = "\nUnmatched $cnt build dirs...\n"; prt($msg); $txt .= $msg; for ($j = 0; $j < $cnt; $j++) { $i = $arr[$j]; $ra = $builds[$i]; ## 0 1 2 3 4 5 #push(@builds,[$ff,$bmf,$file,$time,$size,$src]); $ff = ${$ra}[0]; $bmf = ${$ra}[1]; $file = ${$ra}[2]; # ACTUALLY IS A DIRECTORY $time = ${$ra}[3]; $size = ${$ra}[4]; $proj = ${$ra}[5]; $file .= ' ' while (length($file) < $max); $proj .= ' ' while (length($proj) < $max2); $atim = lu_get_YYYYMMDD_hhmmss($time); $asiz = sprintf("%7u",$size); $acnt = sprintf("%2u",($j + 1)); $msg = "$acnt: $proj $file $atim $asiz\n"; prt($msg); $txt .= $msg; } } if (length($out_file)) { rename_2_old_bak($out_file); write2file($txt,$out_file); prt("List written to [$out_file]\n"); } } ######################################### ### MAIN ### parse_args(@ARGV); process_in_dir($in_dir,0); 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); my $verb = VERB2(); while (@av) { $arg = $av[0]; if ($arg =~ /^-/) { $sarg = substr($arg,1); $sarg = substr($sarg,1) while ($sarg =~ /^-/); if (($sarg =~ /^h/i)||($sarg =~ /^\?/)) { 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); } } $verb = VERB2(); prt("Verbosity = $verbosity\n") if ($verb); } elsif ($sarg =~ /^l/) { if ($sarg =~ /^ll/) { $load_log = 2; } else { $load_log = 1; } prt("Set to load log at end. ($load_log)\n") if ($verb); } elsif ($sarg =~ /^o/) { need_arg(@av); shift @av; $sarg = $av[0]; $out_file = $sarg; prt("Set out file to [$out_file].\n") if ($verb); } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { $in_dir = $arg; prt("Set input to [$in_dir]\n") if ($verb); } shift @av; } if ($debug_on) { prtw("WARNING: DEBUG is ON!\n"); if (length($in_dir) == 0) { $in_dir = $def_file; prt("Set DEFAULT input to [$in_dir]\n"); } } if (length($in_dir) == 0) { pgm_exit(1,"ERROR: No input directory found in command!\n"); } if (! -d $in_dir) { pgm_exit(1,"ERROR: Unable to find in directory [$in_dir]! Check name, location...\n"); } } sub give_help { prt("$pgmname: version $VERS\n"); prt("Usage: $pgmname [options] in-directory\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 (-o) = Write output to this file.\n"); prt("\n"); prt(" Given an input directory, search one level down for 'standard' projects.\n"); prt(" A 'build' directory should contain a 'build-me.bat', and source folders\n"); prt(" should contain a CMakeLists.txt. These will be searched for known contents.\n"); prt(" At end of search a list of projects found will be output to the out file.\n"); } # eof - template.pl