vc8srcs02.pl to HTML.

index -|- end

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

index -|- top

checked by tidy  Valid HTML 4.01 Transitional