Generated: Tue Feb 2 17:54:59 2010 from vc8srcs02.pl 2006/11/28 16.2 KB.
#!/Perl # vc8srcs02.pl # AIM: Source list from MSVC8 project file # but this version starts with the SOLUTION (.sln) file, # finds the PROJECT (.vcproj), and does a source compare # with the relative directories given in there ... # First try, using XML::Simple, so use XML::Simple; # 20061128 - BUT XML::Simple IS NOT SO SIMPLE!!! See vc8scrs03.pl for try WITHOUT use Data::Dumper; # just for DEBUG, when the parsing goes wrong ... 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 ... # NOTE: Reports - could not find ParserDetails.ini in C:/Perl/site/lib/XML/SAX # from : http://perl-xml.sourceforge.net/faq/#parserdetails.ini # Suggestion: run - ppm install http://theoryx5.uwinnipeg.ca/ppms/XML-SAX.ppd # set a DEFAULT input file name my $in_file = 'C:\FG\FG0910-8\fgfs\fgfs.sln'; ##my $in_file = 'F:\FG0910-4\flightgear\projects\VC8\FlightGear.sln'; ##my $in_file = 'F:\FG0910-4\simgear\projects\VC8\simgear.sln'; ### features my $DO_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 $in_dir = ''; my $dbg_on1 = 0; my $dbg_on2 = 0; my $dbg_on3 = 0; my $dbg_on4 = 0; my $dbg_on5 = 0; # show squirling down my $dbg_src = 0; # show each SOURCE, as found # log file stuff my ($LF); my $outfile = 'temp.'.$0.'.txt'; open_log($outfile); my $file = ''; my $ff = ''; 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 @am_sources = (); prt( "$0 ... Hello, World ...\n" ); if (@ARGV) { $in_file = shift @ARGV; } if ( -f $in_file ) { if (is_solution($in_file)) { get_xml_projects(); } elsif (is_vcproj($in_file)) { push(@proj_files, $in_file); } else { prt( "WARNING: Unknown file type [$in_file] ...\n" ); prt( "Proceeding ASSUMING a project (XML) file ...\n" ); push(@proj_files, $in_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) { get_xml_sources($line); $prev_srcs = scalar @csrc_array; $prev_hdrs = scalar @hsrc_array; $prev_othe = scalar @osrc_array; } if($prev_srcs == 0) { mydie("ERROR: No C/C++ sources found to process ...\n"); } prt("\nGetting folder list from C/C++ source files ...\n"); foreach my $fl (@csrc_array) { my $dir = file_dirname($fl); if (!in_dir_array($dir)) { prt("Adding folder [$dir] to \$proj_dirs list ...\n") if ($dbg_on3); push(@proj_dirs, $dir); } } if ($DO_COMPARE) { 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( "ERROR: Can not locate [$in_file] or [$in_dir] ... aborting ...\n" ); } close_log($outfile,1); exit(0); ############################################## ### program subs 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_fd = file_dirname($in_file); prt( "Loading [$in_file] in directory [$in_fd] ...\n" ); open FH, "<$in_file" or mydie( "ERROR: Can not open [$in_file] ... aborting ...\n" ); @lines = <FH>; # slurp the whole file close( FH ); prt( "Got ".scalar @lines." in $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)) { $ff = $in_fd.$par; prt( "Got PROJECT file [$par] " ); if ( -f $ff) { prt( "ok" ); } else { prt( "FAILED" ); } prt("\n"); 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 # 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 { 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; $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)) { 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); if ($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 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); } # 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); prt( "Loading [$in] file in directory [$in_fd] ...\n" ); # create object my $xml = new XML::Simple; #my $xml = new XML::Simple (KeyAttr=>[]); # read XML file my $data2 = $xml->XMLin($in); # print output ###prt( Dumper($data2) ); prt( "Getting array of [$fl1] ...\n" ); my $dfiles = $data2->{$fl1}; #my $files = $data->{$fl1}->{$fl2}; #my $files = $data->{$fl1}->{$fl2}->{$fl3}; #prt( Dumper($dfiles) ); my $type = ref($dfiles); prt( "Processing for each [$fl2] ...type=$type...\n" ); $cnt = 0; if ((defined $type) && ($type eq 'HASH')) { foreach my $e (keys %{$dfiles}) { my $dval = $dfiles->{$e}; $type = ref($dval); prt("key = [$e] ...$type\n") if ($dbg_on5); if ($type eq 'HASH') { foreach my $f (keys %{$dval}) { prt( "Hsubkey = $f ...\n" ) if ($dbg_on5); } } else { foreach my $f (@{$dval}) { my $ty2 = ref($f); prt( "Asubkey = $f ...[$ty2]\n" ) if ($dbg_on5); if ($ty2 eq 'HASH') { foreach my $g (keys %{$f}) { my $ty3 = ref($g); my $dval3 = $f->{$g}; if (ref($dval3) eq 'ARRAY') { prt("Subsubkeys = $g [$ty3] ... ARRAY\n" ) if ($dbg_on5); foreach my $h (@{$dval3}) { my $ty4 = ref($h); prt("Subsubsubkeys = $h [$ty4] ...\n" ) if ($dbg_on5); if ($ty4 eq 'HASH') { foreach my $j (keys %{$h}) { my $dval4 = $h->{$j}; if (ref($dval4) eq 'ARRAY') { prt( "subsubsubsubkeys = $j ... ARRAY\n" ) if ($dbg_on5); } else { if ($j =~ /^RelativePath$/i) { $cnt++; $ff = $in_fd . $dval4; prt( "$cnt $dval4 ($ff)\n" ) if ($dbg_src); if (is_c_source($dval4)) { push(@csrc_array,$ff); } elsif (is_h_source($dval4)) { push(@hsrc_array,$ff); } else { push(@osrc_array,$ff); } } else { prt( "subsubsubsubkeys = $j ... [$dval4]\n" ) if ($dbg_on5); } } } } } } else { prt("Subsubkeys = $g [$ty3] ... $dval3\n" ) if ($dbg_on5); } } } } } } ##close_log($outfile,1); ##exit(0); } else { foreach my $e (@{$dfiles->{$fl2}}) { $cnt++; #prt( Dumper($e) ); $file = $e->{$fl3}; $ff = $in_fd . $dfile; #prt( $e->{$fl3}."\n" ); prt( "$cnt $file ($ff)\n" ); if (is_c_source($dfile)) { push(@csrc_array,$ff); } elsif (is_h_source($dfile)) { push(@hsrc_array,$ff); } else { push(@osrc_array,$ff); } } } if ($cnt == 0) { prt( "\nGot ZERO on [$fl1][$fl2] ... try another way ...\n" ); my @xmlkeys = (); ###my @srcfls = (); ###my @hdrfls = (); foreach my $key (keys %{$data2}) { ##prt( "$cnt $key\n" ); push(@xmlkeys, $key); } my $cnt1 = 0; foreach my $k (@xmlkeys) { $cnt1++; ###prt( "\n$cnt1 $k\n" ); my $data = $data2->{$k}; ###prt( Dumper($data) ); if ($k eq 'Version') { prt( "File Version = ".$data."\n" ); } elsif ($k eq 'Files') { prt( "Enumerating Files ...\n" ); my $cnt2 = 0; foreach my $k2 (keys %{$data}) { $cnt2++; my $data3 = $data->{$k2}; ##prt( "$cnt2 $k2 ...\n" ); my $cnt3 = 0; my $hadsrc = 0; my $hadhdr = 0; my $typ2 = ref($data3); if ($typ2 eq 'ARRAY') { foreach my $k3 (@{$data3}) { $cnt3++; ###prt( " $cnt3\n".Dumper($k3) ); $hadsrc = 0; $hadhdr = 0; foreach my $k4 (keys %{$k3}) { ###prt( " $k4\n" ); if ($k4 =~ /Name/i) { my $vnm = $k3->{$k4}; ###prt( "Name is [$vnm]\n" ); if ($vnm =~ /^Source\s+Files/i) { $hadsrc = 1; } elsif ($vnm =~ /^Header\s+Files/i) { $hadhdr = 1; } } } if ($hadsrc || $hadhdr) { if ($hadsrc) { prt( "Found SOURCE FILES ...\n" ); } else { prt( "Found HEADER FILES ...\n" ); } my $sh = $k3->{'File'}; ###prt( Dumper($sh) ); my $typ3 = ref($sh); if ($typ3 eq 'ARRAY') { foreach my $k5 (@{$sh}) { ###prt( "$k5\n" ); foreach my $k6 (keys %{$k5}) { my $src = $k5->{$k6}; $ff = $in_fd . $src; ###prt( "$k6=$src\n" ); if (is_c_source($src)) { prt( "src $k6=$src\n" ) if ($dbg_on1); push(@csrc_array,$ff); } elsif (is_h_source($src)) { prt( "hdr $k6=$src\n" ) if ($dbg_on1); push(@hsrc_array,$ff); } else { prt( "other $k6=$src\n" ) if ($dbg_on1); push(@osrc_array,$ff); } ##if ($hadsrc) { ## push(@srcfls, $src); ##} else { ## push(@hdrfls, $src); ##} } } } else { prt( "\nFAILED: sh is NOT ARRAY, it is [$typ3] ...\n\n" ); } } } } else { prt( "\nFAILED: data3 is NOT ARRAY, it is [$typ2] ...\n\n" ); } } } } } # if $cnt is ZERO 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" ); prt( "Got ".scalar @csrc_array." C/C++ files, ".scalar @hsrc_array. " header files" ); if (@osrc_array) { prt( " and ".scalar @osrc_array." files" ); } prt("\n"); } 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) ) { return 1; } ##if (!is_h_source($f)) { ## prt( "Item [$f] IS NOT C/C++ SOURCE!\n" ); ##} return 0; } sub is_h_source { my $f = shift; if ( ($f =~ /\.h$/i) || ($f =~ /\.hpp$/i) || ($f =~ /\.hxx$/i) ) { return 1; } ##if (!is_c_source($f)) { ## prt( "Item [$f] IS NOT C/C++ SOURCE!\n" ); ##} 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; } # eof - vc8srcs01.pl