Generated: Tue Feb 2 17:54:31 2010 from dswlist.pl 2009/09/22 19 KB.
#!/perl -w # NAME: dswlist.pl # AIM: Given a MSVC6 DSW files, show the LIST of DSP files it references # or given a FOLDER, search for ALL .DSW files, and show .DSP list. # 20090913 - add command line parsing, and make it more conform to scan of vcproj # substitution variables # -NEW_PROJECT_NAME-" = name of the project # -NEW_OUTD_(REL|DBG)- = PROP Output_Dir ???? # -NEW_INTER_(REL|DBG)- = PROP Intermediate_Dir ???? # ADD CPP with # -NEW_RT_(REL|DBG)- = RUNTIME, like /MT /MD, /MTd, etc # -NEW_INCS_(REL|DBG)- = INCLUDE DIRECTORIES, like /I ".." # -NEW_DEFS_(REL|DBG)- = DEFINES, like /D "FGFS" # ADD LINK32 (for console, app, DLL) with # -NEW_LIBS_(REL|DBG)- = Additional libraries for the link # -NEW_OUT_(REL|DBG)- = link output, like /out:"StaticRelease\libpng.lib # -NEW_POST_(REL|DBG)- = POST build - description and commands, TAB separated # ADD LIB32 (for static library) with # -NEW_OUT_(REL|DBG)- = OUTPUT static library # 22/04/2007 - geoff mclane - http://geoffmclane.com/mperl/samples/index.htm use strict; use warnings; use File::Basename; #use Cwd qw(chdir abs_path); use Cwd; use File::Basename; 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 $outfile = 'temp.'.$pgmname.'.txt'; open_log($outfile); my $recursive = 1; my $show_rel = 1; my $fix_rela = 1; my $show_srcs = 1; # read the DSP, and show the SOURCES contained my $load_log = 0; # load log file at END # debug items my $dbg1 = 0; # show Project line during collection my $dbg2 = 0; # show during collection my $dbg3 = 0; # show during folder collection my $dbg4 = 0; # show Processing my $dbg05 = 0; # show fix_rel details... my $base_dir = "C:\\Projects\\hb\\a52dec\\vc++"; my $def_input = $base_dir."\\a52dec.dsw"; ##my $base_dir = "C:\\FG\\FGCOM"; ##my $base_dir = "C:\\FG\\10\\freeglut"; #\\progs\\demos\\"; ##my $base_dir = "C:\\Projects\\UltraVNC-102-Src\\UltraVNC"; #my $def_input = $base_dir."demos.dsw"; # adjust this to the file you want parsed ##my $def_input = $base_dir; #."\\freeglut.dsw"; # adjust this to the file you want parsed # program global variables my $in_file = ''; my @files = (); my @file_list = (); my $pcnt = 0; my $line = ''; my $wmsg = ''; my $dswcnt = 0; my @warnings = (); #-- get current directory my $pwd = cwd(); my $appt_console_stg = 'Console Application'; my $appt_windows_stg = 'Application'; my $appt_dynalib_stg = 'Dynamic-Link Library'; my $appt_statlib_stg = 'Static Library'; my $appt_utility_stg = 'Utility'; my %master_hash = (); # "Win32 (x86) Dynamic-Link Library" 0x0102 sub get_app_type_stg_local($) { my ($stg) = shift; if ($stg =~ /Static\s+Library/) { return $appt_statlib_stg; } elsif ($stg =~ /Console\s+Application/) { return $appt_console_stg; } elsif ($stg =~ /Dynamic-Link\s+Library/) { return $appt_dynalib_stg; } return "Unresolved [$stg] FIXME in $pgmname!!!"; } sub strip_quotes2($) { my ($ln) = shift; if ($ln =~ /^".*"$/) { $ln = substr($ln,1,length($ln)-2); } return $ln; } # split_space - space_split - # like split(/\s/,$txt), but honour double inverted commas # also accept and split '"something"/>', but ONLY if in the tail sub space_split2($) { my ($txt) = shift; my $len = length($txt); my ($k, $ch, $tag, $incomm, $k2, $nch); my @arr = (); $tag = ''; $incomm = 0; for ($k = 0; $k < $len; $k++) { $ch = substr($txt,$k,1); $k2 = $k + 1; $nch = ($k2 < $len) ? substr($txt,$k2,1) : ""; if ($incomm) { $incomm = 0 if ($ch eq '"'); $tag .= $ch; } elsif ($ch =~ /\s/) { # any spacey char push(@arr, $tag) if (length($tag)); $tag = ''; } elsif (($ch =~ /\//)&&($nch eq '>')) { # 04/10/2008, but only if before '>' 24/09/2008 add this as well push(@arr, $tag) if (length($tag)); $tag = $ch; # restart tag with this character } else { $tag .= $ch; $incomm = 1 if ($ch eq '"'); } } push(@arr, $tag) if (length($tag)); return \@arr; } sub is_c_source_local($) { my $f = shift; if ( ($f =~ /\.c$/i) || ($f =~ /\.cpp$/i) || ($f =~ /\.cxx$/i) ) { return 1; } return 0; } sub show_hash_results2($$) { my ($dbg, $rh) = @_; my ($key, $val, $arr, $itm, $icnt, $i, $msg, $len, $src, $grp, $nm, $dir, $ext); my ($iia, $wmsg, $tmp, $ics, $mlen, $slen); my ($captyp,$cname); my %srcs = (); my @fsrcs = (); my @results = (); $key = '-NEW_PROJECT_NAME-'; if (defined ${$rh}{$key}) { $cname = ${$rh}{$key}; } else { $cname = "Unknown - [$key] NOT SET!"; } $msg = "Application name: $cname"; $msg .= " [key=$key]" if ($dbg & 8); prt("$msg\n"); $key = 'APP_TYPE'; if (defined ${$rh}{$key}) { $captyp = ${$rh}{$key}; } else { $captyp = "Unknown - [$key] NOT SET!"; } $msg = "Application type: $captyp"; $msg .= " [key=$key]" if ($dbg & 8); prt( "$msg\n" ); push(@results, [$cname, $captyp, 0, 0]); foreach $key (sort keys(%{$rh}) ) { $val = $$rh{$key}; $len = length($val); if (($key eq 'C_SOURCES')||($key eq 'H_SOURCES')) { # SHOW of sources and headers in VCPROJ file $icnt = scalar @{$val}; $msg = "$key count $icnt sources ..."; prt( "$msg ($icnt)\n" ); $msg = ''; if ($key eq 'C_SOURCES') { $results[0][3] = $icnt; } elsif ($key eq 'H_SOURCES') { $results[0][4] = $icnt; } # push(@vc_c_sources,[$adddefs, $fname, $flist]); $mlen = 0; for ($i = 0; $i < $icnt; $i++) { $src = $$val[$i][0]; $slen = length($src); $mlen = $slen if ($slen > $mlen); } for ($i = 0; $i < $icnt; $i++) { $src = $$val[$i][0]; ($nm,$dir,$ext) = fileparse( $src, qr/\.[^.]*/ ); $nm = lc($nm); $iia = defined $srcs{$nm}; $ics = is_c_source_local($src); if ($iia) { if ($ics) { $wmsg = "WARNING: Duplicate [$src]! "; prtw( "$wmsg\n" ); } } else { $srcs{$nm} = 1 if ($ics); push(@fsrcs,$src); } $grp = $$val[$i][1]; $msg .= "\n" if length($msg); $tmp = $src; $tmp .= ' ' while (length($tmp) < $mlen); $msg .= $tmp; $msg .= " [$grp]"; ###$msg .= ' '.$$val[$i][2]; } prt( "$msg\n" ) if ($dbg & 4); } elsif (($key eq 'APP_TYPE')||($key eq '-NEW_PROJECT_NAME-')) { # now shown at the beginning # prt( "Application Type [$val]\n" ); } else { # SHOW of other things extracted from the PROJECT file (vcproj or dsp) $arr = space_split2($val); $icnt = scalar @{$arr}; $msg = "$key = ["; $msg .= "$val]"; $msg .= " $icnt items..."; prt( "$msg\n" ) if !($dbg & 1); # will show ALL if dbg & 1 $msg = ''; if ($dbg & 1) { prt( "[dbg1]: Show of $icnt items ...\n" ); for ($i = 0; $i < $icnt; $i++) { $itm = ${$arr}[$i]; if ($itm =~ /^\/(D|I)/) { # /I or /D $i++; if ($i < $icnt) { $src = ${$arr}[$i]; } else { $src = 'OUT OF ITEMS - CHECK ME!'; } prt( "$itm $src\n" ); } else { # other ... prt( "$itm\n" ); } } } } } return \@results; } sub show_master_hash($) { my ($mhr) = @_; my ($key,$hr,$cnt,$ra); $cnt = scalar keys(%{$mhr}); prt( "Show of $cnt items...\n" ); my %h = (); foreach $key (keys %{$mhr}) { prt( "Project [$key]\n" ); $hr = ${$mhr}{$key}; $ra = show_hash_results2(-1,$hr); $h{$key} = $ra; } return \%h; } sub process_in_file($) { my ($inf) = @_; my $ok = 0; if ( -f $inf ) { process_dsw($inf); $ok = 1; } elsif ( -d $inf ) { process_directory( $inf, 0 ); $dswcnt = scalar @file_list; prt( "Found $dswcnt DSW files to process ...\n" ); foreach $line (@file_list) { process_dsw( $line ); } $ok = 1; } else { $wmsg = "WARNING: [$in_file] is NOT file or directory ..."; prt( "$wmsg\n" ); } if ($ok) { prt( "\nShow of MASTER HASH\n" ); my $rr = show_master_hash(\%master_hash); my ($nm,$tp,$ln,$min,$ct); $min = 0; foreach my $k (keys %{$rr}) { my $v = ${$rr}{$k}; $nm = ${$v}[0][0]; $tp = ${$v}[0][1]; $ln = length($nm); $min = $ln if ($ln > $min); } $ct = 0; foreach my $k (keys %{$rr}) { my $v = ${$rr}{$k}; $nm = ${$v}[0][0]; $tp = ${$v}[0][1]; $nm .= ' ' while (length($nm) < $min); $ct++; prt( "$ct: Project: $nm Type: $tp\n" ); } } } parse_args(@ARGV); prt( "$0 ... Using in file [$in_file] ...\n" ); process_in_file($in_file); close_log($outfile,$load_log); exit(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 . "\\" . $file; if (-d $ff) { if ($recursive) { ###if (in_excl_list($file)) { ### push(@folders, sub_main($ff)); ###} $rcnt += process_directory( $ff, $lev + 1 ); } } else { # is a FILE if ( is_my_file($file) ) { push(@file_list, $ff); $rcnt++; } } } return $rcnt; } sub is_my_file { my ($f) = shift; my ($nm,$dir,$ext) = fileparse( $f, qr/\.[^.]*/ ); if (lc($ext) eq '.dsw') { return 1; } return 0; } # ENSURE '/' is used throughout string. sub dos_to_unix { my ($du) = shift; $du =~ s/\\/\//g; return $du; } sub scan_dsp { my @dsplines = @_; my $lncnt = scalar @dsplines; my @dspsrcs = (); my $projname = ''; my $projtype = ''; my $group = ''; my $filter = ''; my ($tmp, $key); my %dsp_hash = (); my $hr = \%dsp_hash; my $mhr = \%master_hash; my @c_sources = (); my @h_sources = (); ###prt( "File contains $lncnt lines ...\n" ); # push(@c_sources,[$src, $group, $filter, 0]); foreach $line (@dsplines) { chomp $line; if ($line =~ /^#\s+Microsoft\s+Developer\s+Studio\s+.+Name="(\w+)".+$/) { $projname = $1; prt( "Project Name [$projname]\n" ); # -NEW_PROJECT_NAME-" = name of the project $key = '-NEW_PROJECT_NAME-'; ${$hr}{$key} = $projname; } elsif ($line =~ /^#\s+TARGTYPE\s+(.*)/) { $tmp = $1; #prt( "# TARGTYPE $1\n" ); $projtype = get_app_type_stg_local($tmp); prt( "Project Type [$projtype]\n" ); $key = 'APP_TYPE'; ${$hr}{$key} = $projtype; } elsif ( $line =~ /^#\s+Begin\s+Group\s+(.*)/ ) { $group = strip_quotes2($1); prt( "Begin Group [$group]\n" ); } elsif ( $line =~ /^#\s+PROP\s+Default_Filter\s+"(.*)".*$/ ) { $filter = $1; prt( "Filter [$filter]\n" ); } elsif ( $line =~ /^SOURCE=/ ) { $line =~ s/^SOURCE=//o; while ($line =~ /\W$/) { # ending in NON-alphanumic ####prt( "Discarding [".substr($line,-1,1)."]!\n" ); $line = substr($line,0,length($line)-1); } ##while (( substr($line,-1,1) eq ' ' )||( substr($line,-1,1) eq "\t")|| ## ( substr($line,-1,1) eq "\r")||( substr($line,-1,1) eq "\n")) { ## $line = substr($line,0,length($line)-1); ##} $line =~ s/^\"//; # remove leading inverted commas $line =~ s/\"$//; # remove trailing inverted commas $line = dos_to_unix($line); $line =~ s/^\.\///; if (($line =~ /\.cxx$/i) || ($line =~ /\.c$/i) || ($line =~ /\.cpp$/i)) { push(@dspsrcs, $line); push(@c_sources, [$line, $group, $filter]); } elsif ( ($line =~ /\.hxx$/i) || ($line =~ /\.h$/i) || ($line =~ /\.hpp$/i) ) { push(@dspsrcs, $line); push(@h_sources, [$line, $group, $filter]); } else { if ( !($line =~ /^\$\(/) ) { prt( "CHECK Discarded [$line]\n" ); } } } } $key = 'C_SOURCES'; ${$hr}{$key} = [@c_sources]; $key = 'H_SOURCES'; ${$hr}{$key} = [@h_sources]; $key = $projname; ${$mhr}{$key} = $hr; $lncnt = scalar @dspsrcs; prt( "File contains $lncnt SOURCES ...\n" ); return \@dspsrcs; } 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 show_files { my (@fils) = @_; my $cnt = 0; foreach $line (@fils) { $cnt++; ###my $rp = substr($line, length($base_dir)); my $rp = remove_base_path($line, $base_dir); if ($show_rel) { if ($fix_rela) { $rp = fix_rel($rp); } prt( "$cnt: [$rp]\n" ); } else { prt( "$cnt: [$line]\n" ); } if ($show_srcs) { # read the DSP, and enumerate the SOURCES if (open(INF, "<$line")) { my @lns = <INF>; close INF; my $lncnt = scalar @lns; prt( "$line contains $lncnt lines to process ...\n" ); my $srcs = scan_dsp(@lns); foreach my $src (@{$srcs}) { prt( " $src\n" ); } } else { prt( "WARNING: Failed to open [$line] ...\n" ); } } } } sub process_dsw { my ($fl) = shift; my @fls = load_in_file( $fl ); prt( "\nFrom $fl got ".scalar @fls." DSP files...\n" ); show_files( @fls ); } sub load_in_file { my ($inf) = shift; my @infs = (); my ($cnt,$nm,$dir,$proj,@arr,$dsp,$ok); ###prt( "Processing $inf ...\n" ); if ( !open INF, "<$inf" ) { $wmsg = "WARNING: Can not OPEN [$inf] ... $! ..."; prt( "$wmsg\n" ); push(@warnings, $wmsg); return @infs; } my @lines = <INF>; close INF; $cnt = scalar @lines; ($nm,$dir) = fileparse($inf); prt( "\nProcessing $cnt lines from [$nm] in [$dir] ...\n" ) if ($dbg4); $cnt = 0; foreach $line (@lines) { $line = trim_all($line); ###if ($line =~ /Project:\s+\"{1}(.+)\"{1}/) { if ($line =~ /Project:\s+(.+)\s+-\s+Package\s+Owner=/) { $cnt++; prt( "$cnt Project [$1] ...\n" ) if ($dbg1); $proj = $1; $proj =~ s/\"//g; @arr = split(/=/, $proj); if (scalar @arr >= 2) { $pcnt++; $dsp = $dir . $arr[1]; $ok = 'NOT FOUND'; if ( -f $dsp) { $ok = 'ok'; } prt( "$pcnt name=[".$arr[0]."], file=[".$arr[1]."] ...$ok \n" ) if ($dbg2); push(@infs, $dsp); } } } $cnt = scalar @infs; prt( "Got $cnt files from $inf ...\n" ) if ($dbg4); return @infs; } sub unix_2_dos { my ($f) = shift; $f =~ s/\//\\/g; return $f; } sub fix_rel { my ($path) = shift; # my @a = split(/\\/, $path); $path = unix_2_dos($path); my @a = split(/\\/, $path); my $npath = ''; my $max = scalar @a; my @na = (); my ($i,$p,$pt); prt( "[dbg05] fix_rel:[$path], split to $max parts...\n" ) if ($dbg05); for ($i = 0; $i < $max; $i++) { $p = $a[$i]; if ($p eq '.') { # ignore this } elsif ($p eq '..') { if (@na) { pop @na; # discard previous } else { prt( "WARNING: Got relative .. without previous!!!\n" ); } } else { prt( "[dbg05] adding [$p]\n" ) if ($dbg05); push(@na,$p); } } foreach $pt (@na) { $npath .= "\\" if length($npath); $npath .= $pt; } prt( "[dbg05] returning [$npath]\n" ) if ($dbg05); return $npath; } sub die_if_no_file { my ($fil) = shift; if ((length($fil) == 0) || !( -f $fil )) { if (length($fil)) { mydie( "ERROR: Can NOT locate [$fil] ... $! ...\n" ); } else { mydie( "ERROR: Must give a DSW input file ...\n" ); } } } sub prt_usage() { prt( "$pgmname [options] in_file_or_directory_name\n" ); prt( "Options: -ll = load log at end\n" ); prt( "If no in_file_or_directory_name given, then will default\n" ); prt( "to [$def_input], if valid!\n" ); } sub parse_args { my (@av) = @_; my ($arg,$cnt); $cnt = scalar @av; prt( "Processing $cnt command arguments...\n" ); while (@av) { $arg = $av[0]; if ($arg =~ /^-/) { if ($arg eq '-ll') { $load_log = 1; prt( "Set to LOAD LOG, at end...\n" ); } else { prt_usage(); mydie( "ERROR: Unparsed argument [$arg]! Aborting!\n" ); } } else { # bare argument if (-f $arg) { $in_file = $arg; prt( "Setting in file to [$in_file]\n" ); } elsif ( -d $arg ) { $in_file = $arg; prt( "Setting in directory to [$in_file]\n" ); } else { prt("Current Work Directory is [$pwd]\n"); mydie( "ERROR: Unable to locate [$arg]! Check name, location...\n" ); } } shift @av; } if (length($in_file) == 0) { if (length($def_input)) { $arg = $def_input; if (-f $arg) { $in_file = $arg; prt( "Setting in file to default [$in_file]\n" ); } elsif ( -d $arg ) { $in_file = $arg; prt( "Setting in directory to default [$in_file]\n" ); } else { prt("Current Word Directory is [$pwd]\n"); mydie( "ERROR: Unable to locate [$arg]! Check name, location...\n" ); } } else { mydie("ERROR: No input file or directory to process!\n"); } } } # eof - dswlist.pl