Generated: Tue Jun 8 17:27:26 2010 from vc8srcs03.pl 2010/04/15 41.2 KB.
#!/usr/bin/perl -w # vc8srcs03.pl # AIM: Source list from MSVC8 project file # but this version starts with the SOLUTION (.sln) file, # finds the PROJECT (.vcproj), and gets the PROJECTS, and # the SOURCES from there, and lists them # 2010/04/15 - add list of 'MISSED' files at end # 13/11/2007 - geoff mclane - http://geoffair.net/mperl use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use Cwd; unshift(@INC, 'C:\GTools\perl'); require "logfile.pl" or die "Missing logfile.pl ...\n"; # my simple log file and some other utility subs require "amfile01.pl" or die "Missing amfile01.pl ...\n"; # parse AM file ... # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /\w{1}:\\.*/) { my @tmpsp = split(/\\/,$pgmname); $pgmname = $tmpsp[-1]; } my $perl_dir = 'C:\GTools\perl'; my $outfile = $perl_dir."\\temp.$pgmname.txt"; open_log($outfile); # User variables my $debug_on = 0; # just to run with defaults my $load_log = 0; # load log at end # set a DEFAULT input file name my $def_root_dir = "C:\\FG\\32\\Atlas\\"; my $def_inp_file = $def_root_dir. "Atlas.sln"; #my $def_root_dir = "C:\\GTools\\tools\\testap3\\"; #my $def_inp_file = $root_dir. "testap3.sln"; #my $def_root_dir = "C:\\FG\\FGCOMXML\\xmlrpc-c\\"; #my $def_inp_file = $root_dir. "Windows\\xmlrpc.sln"; ##my $def_root_dir = "C:\\GTools\\Tools\\Dv32\\"; ##my $def_inp_file = $root_dir . "Dv32.sln"; #my $def_root_dir = "C:\\FGCVS\\iaxclient\\"; #my $def_inp_file = $root_dir . "contrib\\win\\vs2005\\iaxclient.sln"; #my $def_root_dir = "C:\\FG\\FGCOM2\\iaxclient\\lib\\"; #my $def_inp_file = $root_dir . "win\\vs2005\\iaxclient_lib.sln"; ###my $def_root_dir = "C:\\FG\\FGCOM\\xmlrpc-c\\"; ###my $def_inp_file = $root_dir . "Windows\\xmlrpc.sln"; ##my $def_inp_file = 'C:\FG\12\fgfs\fgfs.sln'; ##my $def_inp_file = 'C:\FG\FG0910-8\fgfs\fgfs.sln'; ##my $def_inp_file = 'F:\FG0910-4\flightgear\projects\VC8\FlightGear.sln'; ##my $def_inp_file = 'F:\FG0910-4\simgear\projects\VC8\simgear.sln'; ### features my $AM_COMPARE = 0; # add read makefile.am for sources, but this does NOT work # on projects that do NOT use Makefile.am to control SOURCES my $DSP_COMPARE = 0; # if .DSW and .DSP files found, then extract sourcess my $USE_ROOT_DIR = 1; # use $root_dir, not $top_dir ... my $show_full_source = 1; # do NOT sutract ROOT folder my $SHOW_HDRS_MISSED = 1; # after C sources, show H sources MISSED my $show_full_missing_list = 0; # String constants. my $COMMENT_PATTERN = "^#"; my $MACRO_PATTERN2 = "^([A-Za-z][A-Za-z0-9_]+)[ \t]*=[ \t]*(.*)\$"; ###my @incl_c = qw( .cxx .c .inl .cpp .cc .c++ ); ###my @incl_h = qw( .hxx .h .hh .hpp .h ); my $long_name = ' portaudio\bindings\cpp\source\portaudiocpp\DirectionSpecificStreamParameters.cxx '; my $min_len = length($long_name); ######################################################### # program variables my @warnings = (); # keep warnings my $inp_dir = ''; my $inp_title = ''; my $inp_ext = ''; my $root_dir = ""; my $inp_file = ""; # debug flags my $dbg1 = 0; # show VCPROJ files in SLN file my $dbg2 = 0; # show 'Loading ...' VCPROJ file my $dbg3 = 0; # show "Processing nn lines in $in ..." my $dbg4 = 0; # show "Got new and nn count ..." my $dbg5 = 0; # show "Got PROJECT ..." from DSW file my $dbg6 = 0; # show DSP IF/ELSEIF/ELSE/ENDIF split parsing my $dbg7 = 0; # show "Project=$projname, v=$version\n" my $dbg8 = 0; # show DSP IF/ELSEIF/ELSE/ENDIF parsing my $dbg9 = 0; # show SET macro my $dbg10 = 0; # show DSP counts ... my $dbg11 = 0; # show Begin Group: "Source Files" my $dbg12 = 0; # show "$package TARGET: $1\n" during DSP decode my $dbg_on1 = 0; # show LOADING vcproj ... my $dbg_on2 = 0; # show AM file processing, if any ... my $dbg_on3 = 0; # show adding folder my $dbg_on4 = 0; # show directory and found my $dbg_src1 = 0; # show each SOURCE, as found my $dbg_src2 = 0; # show each HEADER, as found my $dbg_src3 = 0; # show each OTHER, as found my $file = ''; my $fl1 = 'Files'; my $fl2 = 'File'; my $fl3 = 'RelativePath'; my $fl4 = 'Filter'; my $cnt = 0; my @csrc_array = (); my @hsrc_array = (); my @osrc_array = (); my @cdir_array = (); my @hdir_array = (); my @odir_array = (); my @files = (); my @lines = (); my @proj_files = (); my @proj_dirs = (); my @not_found = (); my @not_found2 = (); my $prev_srcs = 0; my $prev_hdrs = 0; my $prev_othe = 0; my $line = ''; my $try3 = 0; my %projfiles = (); # list of SLN projects found, and sources, with FULL path my %projfilesasis = (); # exactly as extracted from the VCPROJ file my %projvcproj = (); my %projhdrs = (); # list of SLN projects HEADERS found, with FULL path my $proj_cnt = 0; my $dsw_file = ''; # SLN to DSW my %dswprojs = (); # Load of DSW file ... my %dspfiles = (); # Load of DSP files ... my %dsphdrs = (); # DSP headers found my $no_dsw = 0; # set to 1 if NO DSW file found my $dsp_cnt = 0; my @sln_missed = (); my @dsw_missed = (); my %macros = (); # macros found in DSP file my $top_dir = ''; # get the TOP directory, from all the SOURCE scanning ... my @all_files = (); # list of ALL files in $top_dir or $root_dir... my $top_cnt = 0; # TYPE is_my_type CONSTANTS my $TYPE_C = 1; my $TYPE_H = 2; my $TYPE_DSW = 3; my $TYPE_SLN = 4; my @am_sources = (); sub show_warnings($) { my ($val) = shift; if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS...\n" ); foreach my $itm (@warnings) { prt("$itm\n"); } prt("\n"); } elsif ($val) { 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 os_is_win() { return (($^O eq 'MSWin32') ? 1 : 0); } # exclude the ROOT FOLDER, # if there is a $root_dir, # and this file BEGINS with that root! sub sub_root_directory($) { my ($fil) = shift; my $lr = length($root_dir); my $lf = length($fil); if ($lr && ($lr < $lf)) { my $off = 0; my $dfil = unix_2_dos($fil); my $droot = unix_2_dos($root_dir); while ( substr($dfil,$off,1) eq substr($droot,$off,1) ) { $off++; } $fil = substr($fil,$off); } return $fil; } sub repeat_missed_items($) { my ($rh) = shift; my ($key,$ra,$cnt,$fil,$cnt1,$cnt2); if (defined ${$rh}{'per_project'}) { # $h{$key} = [ \@arrs, \@arrh ]; $ra = ${$rh}{'per_project'}; $cnt = 0; foreach $key (keys %{$ra}) { my $ras = ${$ra}{$key}[0]; my $rah = ${$ra}{$key}[1]; #my $r = ${$ra}{$key}; #my $ras = ${$r}[0]; #my $rah = ${$r}[1]; $cnt1 = scalar @{$ras}; $cnt2 = scalar @{$rah}; $cnt += $cnt1; $cnt += $cnt2; } if ($cnt) { prt("\nList of $cnt sources, per project, in 'solution', but could NOT be found in $root_dir\n"); foreach $key (keys %{$ra}) { my $ras = ${$ra}{$key}[0]; my $rah = ${$ra}{$key}[1]; #my $r = ${$ra}{$key}; #my $ras = ${$r}[0]; #my $rah = ${$r}[1]; my $cnt1 = scalar @{$ras}; my $cnt2 = scalar @{$rah}; if ($cnt1 || $cnt2) { prt("\nLists for project $key - missing $cnt1 source, $cnt2 headers...\n"); if ($cnt1) { prt("Lists of $cnt1 missing source...\n"); foreach $fil (sort @{$ras}) { prt(" $fil\n"); } } if ($cnt2) { prt("Lists of $cnt2 missing headers...\n"); foreach $fil (sort @{$rah}) { prt(" $fil\n"); } } } } } } if ($show_full_missing_list) { prt("\nFull single list of sources in 'solution', but could NOT be found in $root_dir\n"); foreach $key (keys %{$rh}) { next if ($key eq 'per_project'); $ra = ${$rh}{$key}; $cnt = scalar @{$ra}; if ($cnt) { prt("Lists of missing $key...\n"); foreach $fil (sort @{$ra}) { prt("$fil\n"); } } } } } # ===================================================== ### MAIN ### # ===================================================== parse_args(@ARGV); ($inp_title, $inp_dir, $inp_ext) = fileparse( $inp_file, qr/\.[^.]*/ ); $inp_dir = cwd().'/' if ($inp_dir =~ /^\.(\\|\/)$/); if (length($root_dir) == 0) { $root_dir = $inp_dir; prt("Set ROOT directory [$root_dir] per input file [$inp_file]\n"); } if ( -f $inp_file ) { if (is_solution($inp_file)) { get_xml_projects($inp_file); if ($DSP_COMPARE) { $dsw_file = $inp_dir . $inp_title . ".dsw"; if (-f $dsw_file) { $no_dsw = 0; get_dsw_projects($dsw_file); } else { $no_dsw = 1; prtw( "WARNING: Unable to locate a $inp_title DSW file ...\n" ); } } } elsif (is_vcproj($inp_file)) { push(@proj_files, $inp_file); } else { prt( "WARNING: Unknown file type [$inp_file] ...\n" ); prt( "Proceeding ASSUMING a project (XML) file ...\n" ); push(@proj_files, $inp_file); } if (@proj_files) { prt("Processing ".scalar @proj_files." file(s) ...\n"); } else { mydie( "ERROR: Have no PROJECT (.vcproj) files to process!\n" ); } foreach $line (@proj_files) { # process EACH .vcproj file found in .SLN get_xml_sources($line); # extract XML source from vcproj file $prev_srcs = scalar @csrc_array; $prev_hdrs = scalar @hsrc_array; $prev_othe = scalar @osrc_array; } if ($DSP_COMPARE) { my $dspcnt = scalar keys(%dswprojs); if ($dspcnt) { prt( "DSP_COMPARE: Loading $dspcnt DSP files from DSW file ...\n" ); } else { if ($no_dsw) { prt( "DSP_COMPARE: No DSW file found ...\n" ); } else { prt( "DSP_COMPARE: DSW found, but NO Projects found ...\n" ); } } foreach my $key (keys %dswprojs) { my @ra = load_dsp( $key, $dswprojs{$key} ); my $ds = $ra[0][0]; $dspfiles{$key} = $ds; $dsphdrs{$key} = $ra[0][1]; } } else { prt( "No DSP compare since \$DSP_COMPARE is OFF ($DSP_COMPARE)\n" ); } if($prev_srcs) { process_sources(); } else { prt("ERROR: No C/C++ sources found to process ...\n"); } } else { prt( "ERROR: Can not locate [$inp_file] ... $! ...\n" ); if ( -d $inp_dir ) { prt( "Note: [$inp_dir] does exist ...\n" ); } else { prt( "Note: [$inp_dir] does not exist ...\n" ); } } if ($USE_ROOT_DIR) { if (length($root_dir)) { if (-d $root_dir) { # we have a VALID TOP DIRECTORY get_top_files( $root_dir, 0 ); $top_cnt = scalar @all_files; } else { prtw( "WARNING: [$root_dir] NOT VALID!!!\n" ); } } else { prtw( "WARNING: ROOT DIRECTORY [$root_dir] NOT SET!!!\n" ); } } else { if (length($top_dir)) { if (-d $top_dir) { # we have a VALID TOP DIRECTORY get_top_files( $top_dir, 0 ); $top_cnt = scalar @all_files; } else { prtw( "WARNING: [$top_dir] NOT VALID!!!\n" ); } } else { prtw( "WARNING: top_dir NOT SET!!!\n" ); } } ######### SOURCE LIST DISPLAY ############ $proj_cnt = scalar keys( %projfiles ); $dsp_cnt = scalar keys( %dspfiles ); prt( "Top count $top_cnt, sln count $proj_cnt, dsw count $dsp_cnt...\n" ); my $ref_missed = undef; if ($proj_cnt) { $ref_missed = show_vc8_sources(); } if ($dsp_cnt) { show_dsp_sources(); } if (!$no_dsw) { show_dsw_compare(); } show_all_sources(); if (defined $ref_missed) { repeat_missed_items($ref_missed); } ########################################## pgm_exit(0,"Normal exit(0)\n"); # === end MAIN ============================================= ############################################## ### program subs sub show_dsw_compare { my $dmcnt = scalar @dsw_missed; if ($dmcnt) { prt( "\nNOTE: $dmcnt files in SLN, NOT in DSW ...\n" ); for (my $i = 0; $i < $dmcnt; $i++) { prt( "P=$dsw_missed[$i][0] - S=$dsw_missed[$i][1]\n" ); } } my $smcnt = scalar @sln_missed; prt( "\nNOTE: $smcnt files in DSW, NOT in SLN ...\n" ); if ($smcnt) { for (my $i = 0; $i < $smcnt; $i++) { prt( "P=$sln_missed[$i][0] - S=$sln_missed[$i][1]\n" ); } } } sub in_dsw_srcs { my ($prj, $fil) = @_; if (defined $dspfiles{$prj}) { my $lcfil = lc($fil); my $dfs = $dspfiles{$prj}; my @df = split(/\*/, $dfs); foreach my $f (@df) { if (lc($f) eq $lcfil) { return 1; } } } return 0; } sub in_dsw_hdrs { my ($prj, $fil) = @_; if (defined $dsphdrs{$prj}) { my $lcfil = lc($fil); my $dfs = $dsphdrs{$prj}; my @df = split(/\*/, $dfs); foreach my $f (@df) { if (lc($f) eq $lcfil) { return 1; } } } return 0; } sub in_sln_srcs { my ($prj, $fil) = @_; if (defined $projfiles{$prj}) { my $lcfil = lc($fil); my $dfs = $projfiles{$prj}; my @df = split(/\*/, $dfs); foreach my $f (@df) { if (lc($f) eq $lcfil) { return 1; } } } return 0; } sub show_vc8_sources { prt( "\nList of $proj_cnt VC8 projects, and their SOURCES ... SLN = $inp_file\n" ); my $msg = ''; my ($mk, $key, $pfs, $inf, @pf, $cnt, $fl,$mbe); my @missed_srcs = (); my @missed_hdrs = (); my %h = (); $mbe = 0; foreach $key (keys %projfiles) { $pfs = $projfiles{$key}; #my $pfs2 = $projfilesasis{$key}; $inf = $projvcproj{$key}; @pf = split(/\*/, $pfs); #my @pf2 = split(/\*/,$pfs2); $cnt = scalar @pf; prt( "\nVC8 Project: $key, has $cnt sources ... root = $root_dir\n" ); my @arrs = (); my @arrh = (); foreach $fl (sort @pf) { ##$msg = "$fl "; if ($show_full_source) { $msg = " $fl "; } else { $msg = " ".sub_root_directory($fl)." "; } if ($dsp_cnt) { # we have DSW/DSP sources - COMPARE if (in_dsw_srcs($key, $fl)) { $msg .= "(in DSW)"; } else { push(@dsw_missed, [$key, $fl]); $msg .= "MISSING in DSW"; } } $mk = mark_all_files($fl); $msg .= ' ' while (length($msg) < $min_len); if ($mk) { $msg .= ' ok'; } else { $msg .= ' MISSED!'; if (-f $fl) { $msg .= " but exists"; $mbe++; } else { push(@missed_srcs,$fl); push(@arrs,$fl); } #my ($nm1,$dr1) = fileparse($fl); #foreach my $itm (@pf2) { # my ($nm2,$dr2) = fileparse($itm); # if ($nm1 eq $nm2) { # $msg .= " [$itm] in $inf"; # last; # } #} } prt( "$msg\n" ); } if ($SHOW_HDRS_MISSED) { if (defined $projhdrs{$key}) { $pfs = $projhdrs{$key}; # extract HEADERS @pf = split(/\*/, $pfs); # split them up $cnt = scalar @pf; # get COUNT prt( "VC8 Project: $key, has $cnt HEADERS ... root = $root_dir\n" ); foreach $fl (sort @pf) { ##$msg = "$fl "; if ($show_full_source) { $msg = " $fl "; } else { $msg = " ".sub_root_directory($fl)." "; } if ($dsp_cnt) { # we have DSW/DSP sources - COMPARE if (in_dsw_hdrs($key, $fl)) { $msg .= "(in DSW)"; } else { push(@dsw_missed, [$key, $fl]); $msg .= "MISSING in DSW"; } } $mk = mark_all_files($fl); while (length($msg) < $min_len) { $msg .= ' '; } if ($mk) { $msg .= ' ok'; } else { $msg .= ' MISSED!'; if (-f $fl) { $msg .= " but exists"; } else { push(@missed_hdrs,$fl); push(@arrh,$fl); } } prt( "$msg\n" ); } } } $h{$key} = [ \@arrs, \@arrh ]; } prtw("WARNING: Got $mbe source NOT found in the scan, but do exist!\n". "Appears ROOT directory (-r <dir>) not correctly set!\n". "root_dir set to [$root_dir]\n") if ($mbe); my %hash = (); $hash{'srcs'} = \@missed_srcs; $hash{'hdrs'} = \@missed_hdrs; $hash{'per_project'} = \%h; return \%hash; } sub show_dsp_sources { prt( "\nList of $dsp_cnt DSP projects, and their SOURCES ...\n" ); my $msg = ''; my ($mk); foreach my $key (keys %dspfiles) { my $pfs = $dspfiles{$key}; my @pf = split(/\*/, $pfs); my $cnt = scalar @pf; prt( "\nDSP Project: $key, has $cnt sources ... root = $root_dir\n" ); foreach my $fl (sort @pf) { ##$msg = "$fl "; $msg = " ".sub_root_directory($fl)." "; if ($proj_cnt) { # we have SLN/VCPROJ sources - COMPARE if (in_sln_srcs($key, $fl)) { $msg .= "(in SLN)"; } else { push(@sln_missed, [$key, $fl]); $msg .= "MISSING in SLN"; } } $mk = mark_all_files($fl); while (length($msg) < $min_len) { $msg .= ' '; } if ($mk) { $msg .= ' ok'; } else { $msg .= ' MISSED!'; } prt( "$msg\n" ); } } } sub get_dsw_projects { my ($inf) = shift; # the $dsw_file if (open INF, "<$inf") { my @lns = <INF>; close INF; prt( "DSP_COMPARE: Processing [$inf], got ".scalar @lns." lines ...\n" ); my ($nm, $dir, $ext) = fileparse( $inf, qr/\.[^.]*/ ); my $dcnt = 0; foreach my $ln (@lns) { # seeking Project: "gennmtab"=".\gennmtab.dsp" - Package Owner=<4> if ($ln =~ /^Project:\s+"(\w+)"="*([\w\.\\]+)"*\s+/) { my $pn = $1; my $pf = $2; my $ff = fix_rel($dir . $pf); $dcnt++; prt( "Got Project: $pn, $ff ...\n" ) if ($dbg5); if (defined $dswprojs{$pn} ) { prt( "WARNING: Duplicate PROJECT [%pn] ... $pf versus ".$dswprojs{$pn}."\n" ); } else { $dswprojs{$pn} = $ff; # keep project DSP file } } } prt( "DSP_COMPARE: Got $dcnt DSP files ...\n" ); } else { prt( "WARNING: Unable to OPEN $inf ... $! ...\n" ); } } sub process_sources { if ($AM_COMPARE) { prt("\nGetting folder list from C/C++ source files ...\n"); foreach my $fl (@csrc_array) { # my $dir = file_dirname($fl); my ($nam,$dir) = fileparse($fl); $dir = cwd().'/' if ($dir =~ /^\.(\\|\/)$/); if (!in_dir_array($dir)) { prt("Adding folder [$dir] to \$proj_dirs list ...\n") if ($dbg_on3); push(@proj_dirs, $dir); } } prt("Got ".scalar @proj_dirs." folders to check ...\n" ); $prev_srcs = 0; $prev_hdrs = 0; $prev_othe = 0; foreach my $line2 (@proj_dirs) { get_dir_sources($line2); # and process any AM file found ... $prev_srcs = scalar @cdir_array; $prev_hdrs = scalar @hdir_array; $prev_othe = scalar @odir_array; } cmp_c_sources(); if (@am_sources) { prt("Also got ".scalar @am_sources." SOURCE files from AM files ...\n"); cmp_am_sources(); } } else { prt( "No AM compare, since \$AM_COMPARE is OFF ($AM_COMPARE)\n" ); } } sub in_dir_array { my ($d1) = shift; foreach my $d2 (@proj_dirs) { if ($d1 eq $d2) { return 1; } } return 0; } # get_xml_projects # parse the MS solution file, and extract the VCPROJ files # contined there in ... sub get_xml_projects { my ($in_file) = shift; #my $in_fd = file_dirname($in_file); my ($in_fn,$in_fd) = fileparse($in_file); $in_fd = cwd().'/' if ($in_fd =~ /^\.(\\|\/)$/); prt( "Loading [$in_file] in directory [$in_fd] ...\n" ) if ($dbg_on1); if (open FH, "<$in_file") { @lines = <FH>; # slurp the whole file close( FH ); } else { prt( "ERROR: Can not open [$in_file] ... \n" ); return; } prt( "Processing ".scalar @lines." lines from $in_file ...\n" ); my $hadver = 0; foreach $line (@lines) { chomp $line; if ($hadver) { if ($line =~ /^Project\s*\(/) { ##prt( "Got project [$line] ...\n" ); my @arr = split( /\"/, $line ); foreach my $par (@arr) { if (is_vcproj($par)) { my $ff = $in_fd.$par; prt( "Got PROJECT file [$par] " ) if ($dbg1); if ( -f $ff) { prt( "ok" ) if ($dbg1); } else { prt( "FAILED" ) if ($dbg1); } prt("\n") if ($dbg1); push(@proj_files, $ff); } } } } else { # seeking 'Microsoft Visual Studio Solution File, Format Version 9.00' #if ($line =~ /^Microsoft\s+.(\d+\.\d+)/) { if ($line =~ /^Microsoft\s+/) { if ($line =~ /.(\d+\.\d+)/) { my $ver = $1; prt( "Got solution file version [$ver] ...\n" ); $hadver = 1; } } } } } # get_dir_sources - part of $AM_COMPARE # Process the relative folders from the project file, # and collect ALL the files in those folders ... # An extension would be to parse the makefile.am, if present, # and check WHAT sources actually SHOULD be included # Some sources belong to other test executable items, or # perhaps are just not used unless certain 'switches' are on ... # And this does NOT include other possible folders, not already # apparent from the VCPROJ files ... sub get_dir_sources { # part of $AM_COMPARE my ($in) = shift; prt( "\nProcessing directory [$in] ...\n" ) if ($dbg_on4); if ( !opendir(DIR, $in) ) { prt( "ERROR: Unable to open directory [$in] ...\n" ); return; }; @files = readdir(DIR); closedir DIR; $cnt = 0; foreach $file (@files) { if (($file eq '.') || ($file eq '..')) { next; } $cnt++; ###$ff = $in_dir . '\\' . $file; my $ff = $in . $file; # prt( "$cnt $file ($ff)\n" ); if (is_c_source($file)) { prt( "src $cnt $file ($ff)\n" ) if ($dbg_on2); push(@cdir_array,$ff); } elsif (is_h_source($file)) { # if .h, .hpp, .hxx prt( "hdr $cnt $file ($ff)\n" ) if ($dbg_on2); push(@hdir_array,$ff); } else { prt( "other $cnt $file ($ff)\n" ) if ($dbg_on2); push(@odir_array,$ff); # seek .am files, and get sources IFF $AM_COMPARE if ($AM_COMPARE && ($file =~ /\.am$/i)) { prt( "\nProcessing AM file [$ff] ...\n" ) if ($dbg_on2); initialize_per_input(); my @arr = read_am_file($ff); foreach my $s (@arr) { my $s2 = trim_line($s); if (length($s2)) { if (is_c_source($s2)) { my $ff2 = $in.$s2; push(@am_sources, $ff2); } elsif (is_h_source($s2)) { # quietly FORGET these ... for now ... } else { prt( "CHECK AM Discarded [$s2] ...\n" ); } } } prt( "Done AM file [$ff] ...got ".scalar @arr." sources ...\n" ) if ($dbg_on2); } } } my $new_srcs = scalar @cdir_array - $prev_srcs; my $new_hdrs = scalar @hdir_array - $prev_hdrs; my $new_othe = scalar @odir_array - $prev_othe; prt( "Got new $new_srcs C/C++ files, $new_hdrs header files, and others $new_othe\n" ) if ($dbg_on4); prt( "Got ".scalar @cdir_array." C/C++ files, ".scalar @hdir_array. " header files" ) if ($dbg_on4); if (@odir_array) { prt( " and ".scalar @odir_array." other files" ) if ($dbg_on4); } prt("\n") if ($dbg_on4); } sub mark_all_files { my ($f) = shift; my $lcf = lc($f); # 0 1 2 3 # push(@all_files, [$df, $ff, 0, $typ]) if ($typ); my $ac = scalar @all_files; for (my $i = 0; $i < $ac; $i++) { my $tf = lc($all_files[$i][1]); if ($tf eq $lcf) { my $ct = $all_files[$i][2]; $ct++; $all_files[$i][2] = $ct; return 1; } } return 0; } sub show_all_sources { my $ac = scalar @all_files; # push(@all_files, [$df, $ff, 0, $typ]) if ($typ); my $mc = 0; my $i = 0; for ($i = 0; $i < $ac; $i++) { if ($all_files[$i][3] == $TYPE_C) { if ($all_files[$i][2] == 0) { $mc++; } } } if ($mc) { prt( "\nSources found, but NOT in 'solution'! - $mc ... root = $top_dir\n" ); for ($i = 0; $i < $ac; $i++) { if ($all_files[$i][3] == $TYPE_C) { if ($all_files[$i][2] == 0) { prt( "$all_files[$i][1]\n" ); } } } prt( "Above $mc Sources NOT INCLUDED in DSW nor SLN ...\n\n" ); } else { prt( "Appears NO sources not included, from root scan = $root_dir\n" ); } if ($SHOW_HDRS_MISSED) { $mc = 0; for ($i = 0; $i < $ac; $i++) { if ($all_files[$i][3] == $TYPE_H) { if ($all_files[$i][2] == 0) { $mc++; } } } if ($mc) { prt( "\nHeaders found, but NOT in 'solution' - $mc ... root = $top_dir\n" ); for ($i = 0; $i < $ac; $i++) { if ($all_files[$i][3] == $TYPE_H) { if ($all_files[$i][2] == 0) { prt( "$all_files[$i][1]\n" ); } } } prt( "Above $mc Headers NOT INCLUDED in DSW nor SLN ...\n\n" ); } else { prt( "Appears NO headers not included, from root scan = $root_dir\n" ); } } } sub get_top_files { my ($td, $dep) = @_; my @dirs = (); prt( "Moment ... collecting files from [$td] ...\n" ) if ($dep == 0); $td = unix_2_dos($td); #$td .= "\\" if (substr($td,length($td)-1) ne "\\"); $td .= "\\" if !($td =~ /(\\|\/)$/); if (opendir(DIR, $td)) { my @dfiles = readdir(DIR); close DIR; foreach my $df (@dfiles) { next if (($df eq '.') || ($df eq '..')); my $ff = $td.$df; if (-f $ff) { my $typ = is_my_type($df); push(@all_files, [$df, $ff, 0, $typ]) if ($typ); } elsif (-d $ff) { push(@dirs,$ff); } else { prt( "WARNING: What is THIS [$ff] ???\n" ); } } } else { prt( "WARNING: Unable to OPEN directory $td ...\n" ); } foreach my $de (@dirs) { get_top_files($de, ($dep + 1) ); } } sub trimall($) { my ($ln) = shift; chomp $ln; # remove CR (\n) $ln =~ s/\r$//; # remove LF (\r) $ln =~ s/\t/ /g; # TAB(s) to a SPACE $ln =~ s/\s\s/ /g while ($ln =~ /\s\s/); # all double space to SINGLE $ln = substr($ln,1) while ($ln =~ /^\s/); # remove all LEADING space $ln = substr($ln,0, length($ln) - 1) while ($ln =~ /\s$/); # remove all TRAILING space return $ln; } # get_xml_source # process the XML project file (*.vcproj) and # extract the SOURCE file list sub get_xml_sources { my ($in) = shift; #my $in_fd = file_dirname($in); # this could be the TOP, if no relative sources my ($in_fn,$in_fd) = fileparse($in); # this could be the TOP, if no relative sources $in_fd = cwd().'/' if ($in_fd =~ /^\.(\\|\/)$/); my ($src, $ff, $rff, $ll, $td); my $stf = '<File\\s+RelativePath=\\"([\\.\\\\\\w-]+)+\\"+(.)+'; prt( "Loading [$in] file in directory [$in_fd] ...\n" ) if ($dbg2); if (open FH, "<$in") { @lines = <FH>; # slurp the whole file close( FH ); } else { prtw( "ERROR: Can not open [$in] ...\n" ); return; } my $fline = ''; my $version = ''; my $projname = ''; my @p_files = (); my @p2_files = (); # as is, from VCPROJ my @h_files = (); prt( "Processing ".scalar @lines." lines in $in file...\n" ) if ($dbg3); my $hadver = 0; # get PROJECT NAME - seek - # <VisualStudioProject # ProjectType="Visual C++" # Version="8.00" # Name="cpptest" # ProjectGUID="{B5BF7E93-54ED-4353-8D18-8F9BC11E1EDE}" # > foreach $line (@lines) { $line = trimall($line); $ll = length($line); if ($ll) { $fline .= ' ' if length($fline); $fline .= $line; } if ($fline =~ />/) { if ($fline =~ /<VisualStudioProject\s+/) { if ($fline =~ /.+Version="(\d+\.{1}\d+)+".+/ ) { $version = $1; } if ($fline =~ /.+Name="(\w+)".+/) { $projname = $1; } ##prt( "$fline\n" ); prt( "Project=$projname, v=$version\n" ) if ($dbg7); } # <File RelativePath="src\FDM\SP\ACMS.cxx" > if ($fline =~ /$stf/) { $src = $1; # actual VCPROJ source $rff = $in_fd . $src; # source, relative to .vcproj folder $ff = fix_rel($rff); # remove relative, if any if ($rff =~ /\\\.\.\\/) { $td = get_comm_dir( $ff, $rff ); if (length($td)) { if (length($top_dir)) { if ((lc($top_dir) ne lc($td)) && ( length($td) < length($top_dir)) ) { $top_dir = $td; prt( "CHANGED TOP DIRECTORY to [$top_dir] ...\n" ); } } else { $top_dir = $td; prt( "Set TOP DIRECTORY to [$top_dir] ...\n" ); } } } if (is_c_source($src)) { prt("SOURCE=[$src]\n") if ($dbg_src1); push(@csrc_array,$ff); push(@p_files, $ff); push(@p2_files, $src); } elsif (is_h_source($src)) { #if .h, .hpp or .hxx prt("HEADER=[$src]\n") if ($dbg_src2); push(@hsrc_array,$ff); push(@h_files, $ff); # save HEADER } elsif (is_h_special($src)) { # files with NO extension!!! prt("HEADER=[$src]\n") if ($dbg_src2); push(@hsrc_array,$ff); } else { prt("OTHER=[$src]\n") if ($dbg_src3); push(@osrc_array,$ff); } } else { #prt( "$fline\n" ); } $fline = ''; } } if (@p_files) { if (length($projname)) { if (defined $projfiles{$projname}) { prt( "\nWARNING: DUPLICATE PROJECT NAME $projname in $in ...\n\n" ); } else { $projfiles{$projname} = join('*', @p_files); $projhdrs{$projname} = join('*', @h_files); $projfilesasis{$projname} = join('*',@p2_files); # and a list AS IS $projvcproj{$projname} = $in; # and KEEP the project VCPROJ name ###write2file( join("\n",@h_files)."\n", "temphdrs.txt" ); } } else { prt( "\nWARNING: FAILED TO FIND PROJECT NAME in $in ...\n\n" ); } } else { prt( "\nWARNING: Got NO C sources from $in ...\n\n" ); } my $new_srcs = scalar @csrc_array - $prev_srcs; my $new_hdrs = scalar @hsrc_array - $prev_hdrs; my $new_othe = scalar @osrc_array - $prev_othe; prt( "Got new $new_srcs C/C++ files, $new_hdrs header files, and others $new_othe\n" ) if ($dbg4); prt( "Got ".scalar @csrc_array." C/C++ files, ".scalar @hsrc_array. " header files" ) if ($dbg4); if (@osrc_array) { prt( " and ".scalar @osrc_array." other files" ) if ($dbg4); } prt("\n") if ($dbg4); } sub cmp_c_sources { my ($f1, $f2); my $fnd = 0; my $ft = ''; prt( "\nComparing C/C++ sources ...\n" ); prt( "\nFinding ".scalar @csrc_array." from \@csrc_array, in ".scalar @cdir_array." of \@cdir_array...\n"); $cnt = 0; foreach $f1 (@csrc_array) { $fnd = 0; foreach $f2 (@cdir_array) { if ( lc(file_name($f1)) eq lc(file_name($f2)) ) { $fnd = 1; last; } } if ($fnd == 0) { $ft = file_name($f1); prt( "NOT FOUND $ft [$f1]\n" ); push(@not_found, $f1); $cnt++; } } if ($cnt) { prt( "MISSED $cnt - It appears these need to be DELETED from the PROJECT file ...\n" ); } prt( "\nFinding ".scalar @cdir_array." from \@cdir_array, in ".scalar @csrc_array." of \@csrc_array...\n"); $cnt = 0; foreach $f1 (@cdir_array) { $fnd = 0; foreach $f2 (@csrc_array) { if ( lc(file_name($f1)) eq lc(file_name($f2)) ) { $fnd = 1; last; } } if ($fnd == 0) { $ft = file_name($f1); prt( "NOT FOUND $ft [$f1]\n" ); push(@not_found, $f1); $cnt++; } } if ($cnt) { prt( "MISSED $cnt - It appears these need to be ADDED to the PROJECT file ...\n" ); } if (@not_found) { prt( "\nCHECK this list of ".scalar @not_found." files carefully ...\n" ); } } sub cmp_am_sources { my ($f1, $f2); my $fnd = 0; my $ft = ''; prt( "\nComparing C/C++ sources from AM files ...\n" ); prt( "\nFinding ".scalar @csrc_array." from \@csrc_array, in ".scalar @am_sources." of \@am_sources...\n"); $cnt = 0; foreach $f1 (@csrc_array) { $fnd = 0; foreach $f2 (@am_sources) { if ( lc(file_name($f1)) eq lc(file_name($f2)) ) { $fnd = 1; last; } } if ($fnd == 0) { $ft = file_name($f1); prt( "NOT FOUND $ft [$f1] DELETE?\n" ); push(@not_found2, $f1); $cnt++; } } if ($cnt) { prt( "MISSED $cnt - It appears these need to be DELETED from the PROJECT file ...\n" ); } prt( "\nFinding ".scalar @am_sources." from \@am_sources, in ".scalar @csrc_array." of \@csrc_array...\n"); $cnt = 0; foreach $f1 (@am_sources) { $fnd = 0; foreach $f2 (@csrc_array) { if ( lc(file_name($f1)) eq lc(file_name($f2)) ) { $fnd = 1; last; } } if ($fnd == 0) { $ft = file_name($f1); prt( "NOT FOUND $ft [$f1] ADD?\n" ); push(@not_found2, $f1); $cnt++; } } if ($cnt) { prt( "MISSED $cnt - It appears these need to be ADDED to the PROJECT file ...\n" ); } if (@not_found2) { prt( "\nCHECK this list of ".scalar @not_found2." files carefully ...\n" ); } } ### utitlity subs sub is_c_source { my ($f) = shift; if ( ($f =~ /\.c$/i) || ($f =~ /\.cpp$/i) || ($f =~ /\.cxx$/i) || ($f =~ /\.inl$/i) || ($f =~ /\.cc$/i) ) { return 1; } return 0; } sub is_h_special { my ($f) = shift; if (($f =~ /osg/i)||($f =~ /OpenThreads/i)||($f =~ /Producer/i)) { return 1; } return 0; } sub is_h_source { my ($f) = shift; if ( ($f =~ /\.h$/i) || ($f =~ /\.hpp$/i) || ($f =~ /\.hxx$/i) ) { return 1; } return 0; } sub is_dsw_file { my ($f) = shift; if ( ($f =~ /\.dsw$/i) || ($f =~ /\.dsp$/i) ) { return 1; } return 0; } sub is_sln_file { my ($f) = shift; if ( ($f =~ /\.sln$/i) || ($f =~ /\.vcproj$/i) ) { return 1; } return 0; } sub is_ch_source { my ($f) = shift; if (is_c_source($f) || is_h_source($f)) { return 1; } return 0; } sub is_my_type { my ($f) = shift; if (is_c_source($f)) { return $TYPE_C; } elsif (is_h_source($f)) { return $TYPE_H; } elsif (is_dsw_file($f)) { return $TYPE_DSW; } elsif (is_sln_file($f)) { return $TYPE_SLN; } return 0; } sub is_vcproj { my $fil = shift; if ($fil =~ /\.vcproj$/i) { return 1; } return 0; } sub is_solution { my $fil = shift; if ($fil =~ /\.sln$/i) { return 1; } return 0; } sub unix_2_dos { my ($f) = shift; $f =~ s/\//\\/g; return $f; } # fix relative directory - fix relative path - path fix # Remove any DOT or DOUBLE DOT from the PATH 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 $wmsg = ''; 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]"; prtw( "$wmsg\n" ); } } else { push(@na,$p); } } foreach my $pt (@na) { $npath .= "\\" if length($npath); $npath .= $pt; } return $npath; } sub trim_tail { my ($ln) = shift; while ($ln =~ /\s$/) { $ln = substr($ln,0,length($ln) - 1); # remove all TRAILING space } return $ln; } sub strip_quotes { my ($ln) = shift; if ($ln =~ /^".*"$/) { $ln = substr($ln,1,length($ln)-2); } return $ln; } sub expand_mac { my ($m) = shift; if (defined $macros{$m}) { return $macros{$m}; } return $m; } sub do_if_split { my ($ife) = shift; my @arr = split(/==/,$ife); if (scalar @arr == 2) { my $if0 = strip_quotes(trim_all($arr[0])); my $if1 = strip_quotes(trim_all($arr[1])); prt( "Split is [$if0] == [$if1]\n" ) if ($dbg6); if ($if0 =~ /^\$\((.+)\)$/) { my $mac = $1; my $emac = expand_mac($mac); if ($emac eq $if1) { prt( "Or [$emac] == [$if1] = TRUE\n" ) if ($dbg6); return "TRUE"; } else { prt( "Or [$emac] == [$if1] = FALSE\n" ) if ($dbg6); return "FALSE"; } } } else { prt( "WARNING: Did NOT split! [$ife]\n" ); } return "UDETERMINED"; } sub known_ext { my ($fil) = shift; if ($fil =~ /\.def$/i) { return 1; } elsif ($fil =~ /\.rc$/i) { return 2; } elsif ($fil =~ /\.bmp$/i) { return 3; } elsif ($fil =~ /\.ico$/i) { return 4; } elsif ($fil =~ /\.cur$/i) { return 5; } elsif ($fil =~ /\.txt$/i) { return 6; } elsif ($fil =~ /\.inp$/i) { return 7; } elsif ($fil =~ /\.cnt$/i) { return 8; } elsif ($fil =~ /\.rtf$/i) { return 9; } elsif ($fil =~ /\.dll$/i) { return 10; } elsif ($fil =~ /\.hpj$/i) { return 11; } return 0; } # load a DSP file sources sub load_dsp { my ($prj, $f) = @_; my @dlns = (); my $lncnt = 0; my @dsrcs = (); my @dhdrs = (); my @dothers = (); my @rarr = (); if (open FH, "<$f") { @dlns = <FH>; close FH; $lncnt = scalar @dlns; prt( "File $f contains $lncnt lines ...\n" ) if ($dbg11); } else { prt( "WARNING: FAILED to OPEN [$f] ... $! ...\n" ); } my $intarg = 0; my @arr = (); my $intrue = 0; my $inanif = 0; my $msg = ''; my $package = ''; my ($dsp_name, $dsp_dir) = fileparse( $f ); %macros = (); # clear the DSP macro set foreach my $line (@dlns) { chomp $line; $line = trim_tail($line); # # TARGTYPE "Win32 (x86) Console Application" 0x0103 if ( $line =~ /$COMMENT_PATTERN/ ) { # starts with '#' $line = substr($line,1); if ($line =~ /^\s+TARGTYPE\s+"(.*)"\s+/) { prt( "$package TARGET: $1\n" ) if ($dbg12); } elsif ($line =~ /^\s+Begin\s+Target/) { $intarg = 1; } elsif ($line =~ /^\s+End\s+Target/) { $intarg = 0; } elsif ($line =~ /^\s+Begin\s+Group\s+(.+)/) { # like "Source Files" prt( "Begin Group: $1\n" ) if ($dbg10); } elsif ($line =~ /\s+Microsoft\s+Developer\s+Studio\s+Project\s+File\s-\sName="(\w+)"\s+/ ) { $package = $1; } } elsif ($line =~ /^!/ ) { # starts with '!' $line = substr($line,1); if ($line =~ /^IF\s+(.*)/ ) { $msg = "Entered IF [$1] "; $msg .= do_if_split($1); $inanif++; prt( "$msg $inanif\n" ) if ($dbg8); } elsif ($line =~ /^ELSEIF\s+(.*)/ ) { $msg = "Entered ELSEIF [$1] "; $msg .= do_if_split($1); prt( "$msg $inanif\n" ) if ($dbg8); } elsif ($line =~ /^ELSE\s*/ ) { prt( "Entered ELSE [$line]\n" ) if ($dbg8); } elsif ($line =~ /^ENDIF\s*/ ) { prt( "Out IF with ENDIF\n" ) if ($dbg8); $inanif = 0; } elsif ($line =~ /^MESSAGE\s*/ ) { #prt( "MESSAGE LINE ...\n" ); } else { prt( "WARNING: What is THIS [$line]???\n" ); } } elsif ($intarg) { if( $line =~ /^SOURCE=(.+)/ ) { $line = strip_quotes($1); my $ff = fix_rel($dsp_dir . $line); if (($line =~ /\.cxx$/i) || ($line =~ /\.c$/i) || ($line =~ /\.cpp$/i)) { push(@dsrcs, $ff); } elsif ( ($line =~ /\.hxx$/i) || ($line =~ /\.h$/i) || ($line =~ /\.hpp$/i) ) { push(@dhdrs, $ff); } elsif ( known_ext( $line ) ) { push(@dothers, $ff); } else { prt( "CHECK DSP Discarded $line\n" ); } } } else { # NOT in Begin Target yet if ($line =~ /$MACRO_PATTERN2/) { if (defined $macros{$1}) { if ($macros{$1} ne $2) { prt( "WARNING: Duplicated MACRO $1, now $2, was $macros{$1} ...\n" ); } } else { $macros{$1} = $2; prt( "SET: MACRO $1, to $2 ...\n" ) if ($dbg9); } } } } $lncnt = scalar @dsrcs; prt( "File $f contains $lncnt SOURCES ...\n" ) if ($dbg11); push(@rarr, [join('*',@dsrcs), join('*',@dhdrs), join('*',@dothers)]); return @rarr; } # given say - # absolute path = C:\FG\FGCOM\xmlrpc-c\lib\abyss\src\file.c, and # relative path = C:\FG\FGCOM\xmlrpc-c\Windows\..\lib\abyss\src\file.c sub get_comm_dir { my ($ap, $rp) = @_; my $i = 0; $ap = unix_2_dos($ap); $rp = unix_2_dos($rp); my $max = length($ap); my $lrp = length($rp); $max = $lrp if ($lrp < $max); while( lc(substr($ap,$i,1)) eq lc(substr($rp,$i,1)) ) { $i++; } ### NO, keep trailing '\'$i-- if ($i); # back up one return substr($ap,0,$i); } #================================ sub need_args { my ($arg,@av) = @_; pgm_exit(1,"ERROR: Argument $arg requires following argument!\n") if (!@av); } sub give_help { prt("$pgmname: version 0.0.1 - 2010-04-14\n"); prt("Usages: $pgmname [options] input_file\n"); prt("Options\n"); prt(" -h = This help.\n"); prt(" -l = Load log at end.\n"); prt(" -r <dir> = Set root directory.\n"); prt("Purpose:\n"); prt(" To scan a MSVC solution, reporting sources, and items\n"); prt(" found in a directory scan NOT in the solution.\n"); } sub parse_args { my (@av) = @_; my ($arg,$sarg,$ch); while (@av) { $arg = $av[0]; if ($arg =~ /^-/) { $sarg = substr($arg,1); $sarg = substr($sarg,1) while ($sarg =~ /^-/); $ch = substr($sarg,0,1); if (($ch =~ /h/i)||($ch eq '?')) { give_help(); pgm_exit(0,"Help exit(0)"); } elsif ($ch =~ /r/i) { need_args(@av); shift @av; $sarg = $av[0]; $root_dir = $sarg; prt("Set the ROOT directory to [$root_dir]\n"); } elsif ($ch =~ /l/i) { $load_log = 1; prt("Set to load log at end.\n"); } else { pgm_exit(1,"ERROR: Unknown argument [$arg]! Try -?\n"); } } else { $inp_file = $arg; prt("Set input file to [$inp_file]\n"); } shift @av; } if ((length($inp_file) == 0)&&($debug_on)) { $inp_file = $def_inp_file; $root_dir = $def_root_dir if (length($root_dir) == 0); prt("Set input file to DEFAULT [$inp_file]\n"); } pgm_exit(1,"ERROR: Invalid (or no) input file! [$inp_file]\n") if ((length($inp_file) == 0)|| !(-f $inp_file)); } # eof - vc8srcs03.pl