Generated: Tue Feb 2 17:54:56 2010 from slnlist.pl 2007/09/05 8.2 KB.
#!/perl -w # NAME: slnlist.pl # AIM: Given a MSVC8 SLN file, show the LIST of VCPROJ files it references # 04/09/2007 - add output of SOURCE files from vcproj files # 26/04/2007 - geoff mclane - http://geoffmclane.com/mperl/samples/index.htm use strict; use warnings; use File::Basename; ###################################################################################### require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; # log file stuff my ($LF); my $outfile = 'temp.'.$0.'.txt'; if ($0 =~ /\w{1}:\\.*/) { my @tmpsp = split(/\\/,$0); $outfile = 'temp.'.($tmpsp[-1]).'.txt'; } open_log($outfile); prt( "$0 ... Hello, World ...\n" ); my $show_rel = 1; my $fix_rela = 1; my $show_srcs = 1; # also OUTPUT the SOURCE files in the project files my $recursive = 1; my $dbg_on = 1; # to run without a command line my $base_dir = "C:\\FG\\FGCOM\\iaxclient\\"; my $def_input = $base_dir."contrib\\win\\vs2005\\iaxclient.sln"; ##my $base_dir = "C:\\FG\\FGCOM\\xmlrpc-c\\"; ##my $def_input = $base_dir."Windows\\xmlrpc.sln"; # adjust this to the file you want parsed ###my $base_dir = "C:\\FG\\14\\"; ###my $def_input = $base_dir."fgfs\\fgfs.sln"; # adjust this to the file you want parsed my $in_file = ''; my @file_list = (); my $pcnt = 0; my $line = ''; my ($fil_nm,$fil_dir,$fil_ext); my @warnings = (); my $wmsg = ''; my $cnt = 0; my $srccnt = 0; my @srcsc = (); # list FROM vcproj files my @dir_list = (); # list from DIRECTORY search my $dir_cnt = 0; # debug items my $dbg1 = 0; # show missing as found ... my $dbg3 = 0; my @missing = (); if ($dbg_on) { $in_file = $def_input; } if ((length($in_file) == 0) || !( -f $in_file )) { if (length($in_file)) { mydie( "ERROR: Can NOT locate [$in_file] ... $! ...\n" ); } else { mydie( "ERROR: Must give a SLN input file ...\n" ); } } ($fil_nm,$fil_dir,$fil_ext) = fileparse( $in_file, qr/\.[^.]*/ ); if (lc($fil_ext) eq '.sln') { # push(@projs, [ $arr[0], $arr[1] ]); @file_list = process_sln( $in_file ); } else { mydie( "ERROR: Not a SOLUTION (.sln) file [$in_file] ...\n" ); } $cnt = scalar @file_list; prt( "Got $cnt files from $in_file ...\n" ); my $rp = substr($in_file, length($base_dir)); prt( "Begin List - first solution name, then VCPROJ files ...\n" ); prt( "$rp\n" ); ### push(@projs, [ $arr[0], $arr[1] ]); for (my $i = 0; $i < $cnt; $i++) { $line = $file_list[$i][1]; $line = fix_rel($fil_dir.$line); $rp = substr($line, length($base_dir)); if ($show_rel) { prt( "$rp\n" ); } else { prt( "$line\n" ); } } prt( "End List of first solution name, then VCPROJ files ...\n" ); if ($show_srcs) { for (my $i = 0; $i < $cnt; $i++) { $line = $file_list[$i][1]; $line = fix_rel($fil_dir.$line); $rp = substr($line, length($base_dir)); if ($i == 0) { prt( "The SOLUTION FILE: " ); if ($show_rel) { prt( "$rp\n" ); } else { prt( "$line\n" ); } } else { if (open(INF, "<$line")) { my @lns = <INF>; close INF; process_vcproj_xml_lines($line, @lns); } else { prt( "WARNING: FAILED TO OPEN [$line]! ... $! ...\n" ); } } } } $dir_cnt = process_directory( $base_dir, 0 ); if ($srccnt) { my $ccnt = scalar @srcsc; prt( "Found $srccnt source files, $ccnt C/C++ sources, $dir_cnt from search ...\n" ); # compare push(@srcsc, $asrc); from vcproj, and # push(@dir_list, $ff); from directory search for (my $i = 0; $i < $dir_cnt; $i++) { my $fil1 = $dir_list[$i]; my $fnd = 0; for (my $j = 0; $j < $ccnt; $j++) { my $fil2 = $srcsc[$j]; if ($fil1 eq $fil2) { $fnd = 1; last; } } if (!$fnd) { prt( "$fil1 NOT IN VCPROJ files???\n" ); } } } if (@missing) { my $mcnt = scalar @missing; prt( "Got $mcnt MISSING, as follows ...\n" ); my $cfil = ''; my ($fil, $mis, $i); for ($i = 0; $i < $mcnt; $i++) { $fil = $missing[$i][0]; $mis = $missing[$i][1]; if ($fil ne $cfil) { prt( "Missing from $fil ...\n" ); $cfil = $fil; } prt( "$mis - MISSING\n" ); } } close_log($outfile,1); exit(0); sub process_vcproj_xml_lines { my ($fil, @lines) = @_; my $max = scalar @lines; my $rp = substr($fil, length($base_dir)); my ($nm,$dir) = fileparse($fil); prt( "Got $max lines from $rp to process ...\n" ); my $fline = ''; my $fcnt = 0; for (my $i = 0; $i < $max; $i++) { my $line = $lines[$i]; chomp $line; $line = trim_all($line); $fline .= ' ' if length($fline); $fline .= $line; if ($fline =~ />/) { $fline = trim_all($fline); my $src = ''; my $asrc = ''; my $msg = ''; # check file name - include \w, which include _, ., \, and - - more? if ($fline =~ /<File\sRelativePath="{1}([\.\\\w-]+)"{1}\s*>/i) { $src = $1; $asrc = fix_rel($dir.$src); $msg = "MISSING!"; $msg = "ok" if ( -f $asrc); } elsif ($fline =~ /<File\sRelativePath="{1}(.+)"{1}\s*>/i) { $src = $1; $asrc = fix_rel($dir.$src); $msg = "MISSING!"; $msg = "ok" if ( -f $asrc); $msg .= " *** CHECK ME *** 2"; } if (length($src)) { my ($nm2,$dir2,$ext2) = fileparse($src, qr/\.[^.]*/ ); prt( "$asrc $msg $ext2\n" ) if ($dbg1); my $lcex = lc($ext2); if (($lcex eq '.c')||($lcex eq '.cpp')||($lcex eq '.cxx')) { push(@srcsc, $asrc); } $fcnt++; if ($msg =~ /^MISSING/) { push(@missing, [$fil, $asrc]); } } $fline = ''; } } prt("Count $fcnt ...\n"); $srccnt += $fcnt; } sub unix_2_dos { my ($f) = shift; $f =~ s/\//\\/g; return $f; } sub fix_rel { my ($path) = shift; $path = unix_2_dos($path); # ensure DOS separator my @a = split(/\\/, $path); # split on DOS separator my $npath = ''; my $max = scalar @a; my @na = (); for (my $i = 0; $i < $max; $i++) { my $p = $a[$i]; if ($p eq '.') { # ignore this } elsif ($p eq '..') { if (@na) { pop @na; # discard previous } else { $wmsg = "WARNING: Got relative .. without previous!!! [$path]"; prt( "$wmsg\n" ); push(@warnings,$wmsg); } } else { push(@na,$p); } } foreach my $pt (@na) { $npath .= "\\" if length($npath); $npath .= $pt; } return $npath; } ## } elsif (lc($fil_ext) eq 'sln') { sub process_sln { my ($fil) = shift; my ($lc, $wmsg); prt( "Processing SLN file [$fil] ...\n" ); if ( !open INF, "<$fil" ) { $wmsg = "WARNING: Unable to open [$fil] ..."; prt( "$wmsg\n" ); push(@warnings, $wmsg); return 0; } my @lines = <INF>; close INF; $lc = scalar @lines; prt( "Processing $lc lines ...\n" ); my $cnt = 0; my @projs = (); foreach $line (@lines) { $line = trim_all($line); if ($line =~ /Project\(.*=(.*)/) { $cnt++; ##prt( "$1\n" ); my @arr = split(/,/, $1); if (scalar @arr >= 2) { $arr[0] = trim_all($arr[0]); $arr[1] = trim_all($arr[1]); $arr[0] = substr($arr[0],1,length($arr[0])-2); $arr[1] = substr($arr[1],1,length($arr[1])-2); prt( "$cnt [".$arr[0]."] [".$arr[1]."] ...\n" ); push(@projs, [ $arr[0], $arr[1] ]); } } } $cnt = scalar @projs; prt( "Done $lc lines ... $cnt projects ...\n" ); ##for (my $i = 0; $i < $cnt; $i++) { ## process_vcproj( fix_rel($fil_dir.$projs[$i][1]) ); ##} return @projs; } sub is_my_file { my ($f) = shift; my ($nm,$dir,$ext) = fileparse( $f, qr/\.[^.]*/ ); my $lext = lc($ext); if (($lext eq '.c')||($lext eq '.cpp')||($lext eq '.cxx')) { return 1; } return 0; } sub process_directory { ## $in_folder my ($inf, $lev) = @_; my $rcnt = 0; my ($DH); if ( !opendir($DH, $inf) ) { prt( "ERROR: Unable to OPEN FOLDER [$inf] ... $! ... \n" ); return $rcnt; } my @files = readdir($DH); closedir $DH; my $fcnt = scalar @files; prt( "Have $fcnt to process from $inf ...\n" ) if ($dbg3); foreach my $file (@files) { if (($file eq '.') || ($file eq '..')) { next; } my $ff = $inf; $ff .= "\\" if !($ff =~ /\\$/); $ff .= $file; if ( -d $ff ) { if ($recursive) { ###if (!in_excl_list($file)) { $rcnt += process_directory( $ff, $lev + 1 ); } } else { # is a FILE if ( is_my_file($file) ) { push(@dir_list, $ff); $rcnt++; } } } return $rcnt; } # eof - slnlist.pl