vc6srcs01.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:59 2010 from vc6srcs01.pl 2007/11/27 21.3 KB.

#!/perl -w
# NAME: vc6srcs01.pl
# AIM: Given a DSW solution file, search set of DSP and list sources.
# and given a singel DSP, list sources
# 16/11/2007 - geoff mclane - geoffair.net/mperl
use strict;
use warnings;
use File::Basename;   # to split path into ($name, $dir, $ext) = fileparse($file [, qr/\.[^.]*/] );
require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
require 'utils.pl' or die "Unable to load utils.pl ...\n";
require 'chkmain.pl' or die "Unable to load chkmain.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);
prt( "$0 ... Hello, World ...\n" );
my $root_dir = "C:\\FG\\FGCOM2\\iaxclient\\lib\\"; 
my $in_file = $root_dir . "iaxclient_lib.dsw";
###my $root_dir = "C:\\FGCVS\\FlightGear\\source\\";
###my $in_file = $root_dir . "FlightGear.dsw";
###my $root_dir = "C:\\FG\\FGCOM\\xmlrpc-c1219+\\"; 
###my $root_dir = "C:\\FG\\FGCOM\\xmlrpc-c\\"; 
###my $in_file = $root_dir . "Windows\\xmlrpc.dsw";
# features
my $excl_excluded = 1;   # check for PROP # PROP Exclude_From_Build 1
my $add_mark = 1;      # add 'ok' if found in @all_files, else 'MISSING'
###my $long_name = ' lib/wininet_transport/xmlrpc_wininet_transport.c ';
###my $long_name = ' src\FDM\JSBSim\models\flight_control\FGFCSComponent.cpp ';
my $long_name = '  portaudio\bindings\cpp\source\portaudiocpp\DirectionSpecificStreamParameters.cxx ';
my $min_len = length($long_name);
my $check4main = 1;
my $nomainsort = 0;
my $checkmissed = 1;   # try HARDER to find SOURCE, or replacement
my $showmultiple = 0;   # show if in MULTPILE projects
my %dswprojs = ();
my %dspfiles = ();
my %dspmissed = ();
my @all_files = ();
my %sources2proj = ();
my %dspmacros = ();
my @discardedsrcs = ();
my $customdbg = '';
my $custonrel = '';
# constants
my $COMMENT_PATTERN = "^#";
my $MACRO_PATTERN2 = "^([A-Za-z][A-Za-z0-9_]+)[ \t]*=[ \t]*(.*)\$";
# debug items
my $dbg5 = 0;   # show "Got Project: $pn, $ff ...
my $dbg6 = 0;   # show "Split is [$if0] == [$if1]
my $dbg8 = 0;   # show "Entered IF [$1] $inanif
my $dbg9 = 0;   # show "SET: MACRO $1, to $2 ...
my $dbg10 = 0;   # show "Begin Group: $1
my $dbg11 = 0;   # show "File $f contains $lncnt lines ...
my $dbg30 = 0;   # show "Discarding [$ls] due to Exclude_From_Build ... if $excl_excluded ON
my $dbg40 = 0;   # show "$lncnt: $ln\n" ) if ($dbg40 && length($ln));
my @warnings = ();
my $prj_cnt = 0;
my $dsp_cnt = 0;
if (! -f $in_file) {
   mydie( "ERROR: Can NOT locate [$in_file] file ...\n" );
}
my ($name, $dir, $ext) = fileparse($in_file, qr/\.[^.]*/ );
prt( "Moment, getting full file list of $root_dir ...\n" );
get_top_files( $root_dir );
prt( "Got ".scalar @all_files." files ...\n" );
if ($ext =~ /^\.dsw$/i) {
   get_dsw_projects( $in_file );
   my $mk = mark_all_files( $in_file );
   if (!$mk) {
      my $msg = "WARNING: [$in_file] NOT FOUND in ALL!";
      prt( "$msg\n" );
      push(@warnings,$msg);
   }
} else {
   $dswprojs{'unknown'} = $in_file;
}
$prj_cnt = scalar keys(%dswprojs);
prt( "Got $prj_cnt projects ...\n" );
foreach my $key (keys %dswprojs) {
   my $file = $dswprojs{$key};
   scan_dsp_file($key, $file);
   my $mk = mark_all_files( $file );
}
######### SOURCE LIST DISPLAY ############
$dsp_cnt = scalar keys( %dspfiles );
if ($dsp_cnt) {
   show_dsp_sources($root_dir);   # show, and mark in @all_files ...
   show_other_sources();
   show_sources2proj() if ($showmultiple);
   show_all_sources( "DSW/DSP set", $root_dir );
} else {
   prt( "WARNING: No sources located ...\n" );
}
if (@warnings) {
   prt( "Got ".scalar @warnings." WARNINGS!\n" );
   foreach my $wn (@warnings) {
      prt( "$wn\n" );
   }
}
close_log($outfile,1);
exit(0);
##################################
### subs
sub show_other_sources {
   my @dswm = show_dsw_missed( "DSW set" );
   my @dm = show_dsp_missed( "DSW set" );
   if (@dm) {
      foreach my $df (@dm) {
         my @ds = load_dsp($df);
         my ($n, $d, $e) = fileparse($df, qr/\.[^.]*/ );
         $dspmissed{$n} = join('*',@ds);
         foreach my $pf (@ds) {
            if (defined $sources2proj{$pf}) {
               $sources2proj{$pf} .= '*';
               $sources2proj{$pf} .= $n;
            } else {
               $sources2proj{$pf} = $n;
            }
         }
      }
      prt( "\nNote: Got ".scalar @dm." MISSED DSP projects ...\n" );
      foreach my $ky (keys %dspmissed) {
         my @pf = split(/\*/, $dspmissed{$ky});
         prt( "\nProject: $ky, has ".scalar @pf." files ...\n" );
         foreach my $f (@pf) {
            my $fi = sub_root($f);
            my $mk = mark_all_files($f);
            my $msg = " $fi ";
            if ($add_mark) {
               while (length($msg) < $min_len) {
                  $msg .= ' ';
               }
               if ($mk) {
                  $msg .= " ok";
               } else {
                  $msg .= " MISSED";
                  if ($checkmissed) {
                     my $fnd = find_in_all_files($f);
                     if (length($fnd)) {
                        $msg .= " TRY [$fnd]";
                     } else {
                        $msg .= " NOT FOUND";
                     }
                  }
               }
            }
            prt( "$msg\n" );
         }
      }
   }
}
sub show_sources2proj {
   my $d_cnt = 0;
   my $ky = '';
   foreach $ky (keys %sources2proj) {
      if ($sources2proj{$ky} =~ /\*/) {
         $d_cnt++;
      }
   }
   if ($d_cnt) {
      prt( "\nNOTE: $d_cnt sources are in MULTIPLE projects ...\n" );
      foreach $ky (keys %sources2proj) {
         if ($sources2proj{$ky} =~ /\*/) {
            my $mg = " ".sub_root($ky)." ";
            while (length($mg) < $min_len) {
               $mg .= ' ';
            }
            $mg .= $sources2proj{$ky};
            prt( "$mg\n" );
         }
      }
   } else {
      prt( "NOTE: It appears NO sources are in MULTIPLE projects ...\n" );
   }
}
sub check_build_exclude {
   my ($prj) = shift;
   my @dsr = ();
   #                       0    1         2
   # push(@discardedsrcs, [$ls, $package, $f]);
   my $dcnt = scalar @discardedsrcs;
   if ($dcnt) {
      for (my $i = 0; $i < $dcnt; $i++) {
         my $pk = $discardedsrcs[$i][1];
         if ($pk eq $prj) {
            push(@dsr, $discardedsrcs[$i][0]);
         }
      }
   }
   return @dsr;
}
sub show_dsp_sources {
   my ($rd) = shift;
   prt( "\nList of $dsp_cnt projects, and their SOURCES ...root $rd\n" );
   my $msg = '';
   my $mk = 0;
   foreach my $key (keys %dspfiles) {
      my @pfe = check_build_exclude($key);
      my $cnte = scalar @pfe;
      my $pfs = $dspfiles{$key};
      my @pf = split(/\*/, $pfs);
      my $cnt = scalar @pf;
      prt( "\nProject: $key, has ".($cnt + $cnte)." sources" );
      prt( ", $cnte EXCLUDED!" ) if ($cnte);
      prt( " ...\n" );
      foreach my $fl (sort @pf) {
         $mk = mark_all_files($fl);
         $msg = " ".sub_root($fl)." ";
         if ($add_mark) {
            while (length($msg) < $min_len) {
               $msg .= ' ';
            }
            ###$msg .= ($mk ? " ok" : " MISSED");
            if ($mk) {
               $msg .= " ok";
            } else {
               $msg .= " MISSED";
               if ($checkmissed) {
                  my $fnd = find_in_all_files($fl);
                  if (length($fnd)) {
                     $msg .= " TRY [$fnd]";
                  } else {
                     $msg .= " NOT FOUND";
                  }
               }
            }
         }
         prt( "$msg\n" );
      }
      if ($cnte) {
         prt( "Project: $key, has $cnte sources EXCLUDED from build...\n" );
         foreach my $fl (sort @pfe) {
            $mk = mark_all_files($fl);
            $msg = " ".sub_root($fl)." ";
            if ($add_mark) {
               while (length($msg) < $min_len) {
                  $msg .= ' ';
               }
               $msg .= ($mk ? " ok" : " MISSED");
            }
            prt( "$msg\n" );
         }
      }
   }
}
my %macros = ();
sub scan_dsp_file {
   my ($proj,$file) = @_;
   %macros = ();
   my @ds = load_dsp( $file );
   $dspfiles{$proj} = join('*',@ds);
   foreach my $pf (@ds) {
      if (defined $sources2proj{$pf}) {
         $sources2proj{$pf} .= '*';
         $sources2proj{$pf} .= $proj;
      } else {
         $sources2proj{$pf} = $proj;
      }
   }
}
sub get_dsw_projects {
   my ($inf) = shift;   # the $dsw_file
   prt( "Getting projects from $inf ...\n" );
   my ($msg, $lncnt);
   if (open INF, "<$inf") {
      my @lns = <INF>;
      close INF;
      my ($nm, $dir, $ext) = fileparse( $inf, qr/\.[^.]*/ );
      $lncnt = 0;
      foreach my $ln (@lns) {
         # seeking Project: "gennmtab"=".\gennmtab.dsp" - Package Owner=<4>
         $lncnt++;
         chomp $ln;
         $ln = trim_all($ln);
         prt( "$lncnt: $ln\n" ) if ($dbg40 && length($ln));
         if ($ln =~ /^Project:\s+"(\w+)"="*([\w\.\\]+)"*\s+/) {
            my $pn = $1;
            my $pf = $2;
            my $ff = fix_rel($dir . $pf);
            prt( "Got Project: $pn, $ff ...\n" ) if ($dbg5);
            if (defined $dswprojs{$pn} ) {
               $msg = "WARNING: Duplicate PROJECT [%pn] ... $pf versus ".$dswprojs{$pn};
               prt( "$msg\n" );
               push(@warnings,$msg);
            } else {
               $dswprojs{$pn} = $ff;   # keep project DSP file
            }
         }
      }
   } else {
      $msg = "WARNING: Unable to OPEN $inf ... $! ...";
      prt( "$msg\n" );
      push(@warnings,$msg);
   }
}
# load a DSP file sources
#########################
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);
   my ($msg);
   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 {
      $msg = "WARNING: Did NOT split! [$ife] - returning UNDETERMINED";
      prt( "$msg\n" );
      push(@warnings,$msg);
   }
   return "UNDETERMINED";
}
sub flip_state {
   my ($st) = shift;
   if ($st eq 'TRUE') {
      $st = 'FALSE';
   } elsif ($st eq 'FALSE') {
      $st = 'TRUE';
   }
   return $st;
}
sub clear_per_dsp {
   %macros = ();   # clear DSP macro set
   %dspmacros = ();
   $customdbg = '';
   $custonrel = '';
}
sub load_dsp {
   my ($f) = shift;
   my @dlns = ();
   my $lncnt = 0;
   my @dsrcs = ();
   my $msg = '';
   my $dnname = 0;
   if (open FH, "<$f") {
      @dlns = <FH>;
      close FH;
      $lncnt = scalar @dlns;
      if ($dbg11) {
         prt( "File $f contains $lncnt lines ...\n" );
         $dnname = 1;
      }
   } else {
      $msg = "WARNING: FAILED to OPEN [$f] ... $! ...";
      prt( "$msg\n" );
      push(@warnings,$msg);
   }
   my $intarg = 0;
   my @arr = ();
   my $intrue = 0;
   my $inanif = 0;
   my $package = '';
   my $insrc = 0;
   my $group = '';
   my $ifstate = "INDETERMINATE";
   my $prop = '';
   my ($dsp_name, $dsp_dir) = fileparse( $f );
   my $lnnum = 0;
   clear_per_dsp();   # like %macros = ();   # clear DSP macro set etc
   for (my $i = 0; $i < $lncnt; $i++) {
      $lnnum++;
      my $fline = $dlns[$i];   # extract the LINE
      chomp $fline;
      my $line = trim_tail($fline);
       if ( $line =~ /$COMMENT_PATTERN/ ) {
         # starts with '#'
         $line = substr($line,1);
         if ($line =~ /\s+Microsoft\s+Developer\s+Studio\s+Project\s+File\s-\sName="(\w+)"\s+/ ) {
            $package = $1;
         } elsif ($line =~ /Microsoft Developer Studio Generated Build File, Format Version 6.00/) {
            # ignored
         } elsif ($line =~ /\*\* DO NOT EDIT \*\*/) {
            # ignored
         } elsif ($line =~ /^\s+TARGTYPE\s+"(.*)"\s+/) {
            # # TARGTYPE "Win32 (x86) Console Application" 0x0103
            prt( "$package TARGET: $1\n" );
         } 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"
            $group = strip_quotes($1);
            prt( "Begin Group: $1\n" ) if ($dbg10);
            } elsif ($line =~ /^\s+End\s+Group/) {
            $group = '';
         } elsif ($line =~ /\s*Begin\s+Project/ ) {
         } elsif ($line =~ /\s*End\s+Project/ ) {
         } elsif ($line =~ /Begin\s+Special\s+Build\s+Tool/) {
         } elsif ($line =~ /End\s+Special\s+Build\s+Tool/) {
         } elsif ($line =~ /\s*Name\s+(.+)/) {
         } elsif ($line =~ /\s*Begin\s+Source\s+File/) {
            $insrc = 1;
         } elsif ($line =~ /\s*End\s+Source\s+File/) {
            $insrc = 0;
         } elsif ($line =~ /\s*PROP\s+(.*)/) {
            $prop = $1;
            if ($prop =~ /\s*BASE\s+(.*)/) {
               $prop = $1;
            }
            if ($excl_excluded && $insrc) {
               # PROP Exclude_From_Build 1
               if ($prop =~ /Exclude_From_Build\s+(\d+)/) {
                  if ($1) {
                     if (@dsrcs) {
                        my $ls = pop(@dsrcs);
                        push(@discardedsrcs, [$ls, $package, $f]);
                        prt( "Discarding [$ls] due to Exclude_From_Build ...\n" ) if ($dbg30);
                     }
                  }
               }
            }
         } elsif ($line =~ /\s*ADD\s+(.*)/) {
            $prop = $1;
            if ($prop =~ /\s*BASE\s+(.*)/) {
               $prop = $1;
            }
         } elsif ($line =~ /\s*SUBTRACT\s+(.*)/) {
            $prop = $1;
         } elsif ($line =~ /\s*Begin\s+Custom\s+Build(.*)/) {
            $msg = $1;
            $i++;
            for (; $i < $lncnt; $i++) {
               $fline = $dlns[$i];   # extract the LINE
               chomp $fline;
               $line = trim_tail($fline);
               $msg .= "\n$fline";
               if ($line =~ /\s*End\s+Custom\s+Build/) {
                  last;
               }
            }
         } else {
            prt( "File $f contains $lncnt lines ...\n" ) if (!$dnname);
            $dnname = 1;
            $msg = "WARNING: DSP line $lnnum [$line] not handled!";
            prt("$msg\n");
            push(@warnings,$msg);
         }
        } elsif ($line =~ /^!/ ) {
         # starts with '!'
         $line = substr($line,1);
         if ($line =~ /^IF\s+(.*)/ ) {
            $ifstate = do_if_split($1);
            $msg = "Entered IF [$1] ";
            $msg .= $ifstate;
            $inanif++;
            prt( "$msg $inanif\n" ) if ($dbg8);
         } elsif ($line =~ /^ELSEIF\s+(.*)/ ) {
            $ifstate = do_if_split($1);
            $msg = "Entered ELSEIF [$1] ";
            $msg .= $ifstate;
            prt( "$msg $inanif\n" ) if ($dbg8);
         } elsif ($line =~ /^ELSE\s*/ ) {
            $ifstate = flip_state($ifstate);
            prt( "Entered ELSE [$line]\n" ) if ($dbg8);
         } elsif ($line =~ /^ENDIF\s*/ ) {
            prt( "Out IF with ENDIF\n" ) if ($dbg8);
            $inanif = 0;
            $ifstate = 'OUTIF';
         } elsif ($line =~ /^MESSAGE\s*/ ) {
            #prt( "MESSAGE LINE ...\n" );
         } else {
            $msg = "WARNING: What is THIS [$fline]??? in [$f]";
            prt( "$msg\n" );
            push(@warnings,$msg);
         }
      } 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);
            } else {
               if ( !(($line =~ /\.hxx$/i) || ($line =~ /\.h$/i) || ($line =~ /\.hpp$/i)) ) {
                  $msg = "WARNING: CHECK Discarded [$fline]";
                  prt( "$msg\n" );
                  push(@warnings,$msg);
               }
            }
         }
      } else {
         # NOT in Begin Target yet
         if ($line =~ /$MACRO_PATTERN2/) {
            if (defined $macros{$1}) {
               if ($macros{$1} ne $2) {
                  $msg = "WARNING: Duplicated MACRO $1, now $2, was $macros{$1} ...";
                  prt( "$msg\n" );
                  push(@warnings,$msg);
               }
            } 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);
   return @dsrcs;
}
sub get_top_files {
   my ($td) = shift;
   my @dirs = ();
   my $msg = '';
   $td = unix_2_dos($td);
   $td .= "\\" if (substr($td,length($td)-1) ne "\\");
   if (opendir(DIR, $td)) {
      my @dfiles = readdir(DIR);
      close DIR;
      foreach my $df (@dfiles) {
         if (($df eq '.') || ($df eq '..')) {
            next;
         }
         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 {
            $msg = "WARNING: What is THIS [$ff] ???";
            prt( "$msg\n" );
            push(@warnings,$msg);
         }
      }
   } else {
      $msg = "WARNING: Unable to OPEN directory $td ...";
      prt( "$msg\n" );
      push(@warnings,$msg);
   }
   foreach my $de (@dirs) {
      get_top_files($de);
   }
}
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 find_in_all_files {
   my ($f) = shift;
   my $lcf = lc($f);
   my ($nam, $dir) = fileparse($lcf);
   #                   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 = $all_files[$i][1];
      my $lctf = lc($tf);
      if ($lctf eq $lcf) {
         return $tf;
      }
      my ($tnam, $tdir) = fileparse($lctf);
      if ($nam eq $tnam) {
         return $tf;
      }
   }
   return "";
}
sub show_dsw_missed {
   my ($msg) = shift;
   my $ac = scalar @all_files;
   # push(@all_files, [$df, $ff, 0, $typ]) if ($typ);
   my $mc = 0;
   my $i = 0;
   my $type_dsp = 3;
   my @dm = ();
   my $fil = '';
   my $file = '';
   for ($i = 0; $i < $ac; $i++) {
      if ($all_files[$i][3] == $type_dsp) {
         if ($all_files[$i][2] == 0) {
            $file = $all_files[$i][1];   # extract FILE
            if ($file =~ /\.dsw$/i) {
               $mc++;
               push(@dm, $file);
            }
         }
      }
   }
   if ($mc) {
      prt( "\nDSW/DSP found, but MISSED DSW - $mc ...\n" );
      foreach $file (@dm) {
         $fil = sub_root($file);
         prt( " $fil\n" );
      }
      prt( "Above $mc DSW files NOT INCLUDED in $msg ...\n\n" );
   }
   return @dm;
}
sub show_dsp_missed {
   my ($msg) = shift;
   my $ac = scalar @all_files;
   # push(@all_files, [$df, $ff, 0, $typ]) if ($typ);
   my $mc = 0;
   my $i = 0;
   my $type_dsp = 3;
   my @dm = ();
   my $fil = '';
   my $file = '';
   for ($i = 0; $i < $ac; $i++) {
      if ($all_files[$i][3] == $type_dsp) {
         if ($all_files[$i][2] == 0) {
            $file = $all_files[$i][1];
            if ($file =~ /\.dsp$/i) {
               $mc++;
               push(@dm, $file);
            }
         }
      }
   }
   if ($mc) {
      prt( "\nDSP found, but DSP MISSED - $mc ...\n" );
      foreach $file (@dm) {
         $fil = sub_root($file);
         prt( " $fil\n" );
      }
      prt( "Above $mc DSP files NOT INCLUDED in $msg ...\n\n" );
   }
   return @dm;
}
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 1;
   } elsif (is_h_source($f)) {
      return 2;
   } elsif (is_dsw_file($f)) {
      return 3;
   } elsif (is_sln_file($f)) {
      return 4;
   }
   return 0;
}
sub show_all_sources {
   my ($msg,$rd) = @_;
   my $ac = scalar @all_files;
   # push(@all_files, [$df, $ff, 0, $typ]) if ($typ);
   my $mc = 0;
   my $i = 0;
   my $fil = '';
   my $omsg = '';
   my $file = '';
   for ($i = 0; $i < $ac; $i++) {
      if ($all_files[$i][3] == 1) {
         if ($all_files[$i][2] == 0) {
            $mc++;
         }
      }
   }
   if ($mc) {
      prt( "\nSources found, but MISSED - $mc ...root $rd\n" );
      if ($check4main) {
         if ($nomainsort) {
            for ($i = 0; $i < $ac; $i++) {
               if ($all_files[$i][3] == 1) {
                  if ($all_files[$i][2] == 0) {
                     $file = $all_files[$i][1];
                     $fil = sub_root($file);
                     $omsg = " $fil ";
                     while (length($omsg) < $min_len) {
                        $omsg .= ' ';
                     }
                     if (chkmain($file)) {
                        $omsg .= "Has main().";
                     } else {
                        $omsg .= "NO main() FOUND!";
                     }
                     prt( "$omsg\n" );
                  }
               }
            }
         } else {
            my @hasmain = ();
            my @nomain = ();
            for ($i = 0; $i < $ac; $i++) {
               if ($all_files[$i][3] == 1) {
                  if ($all_files[$i][2] == 0) {
                     $file = $all_files[$i][1];
                     $fil = sub_root($file);
                     if (chkmain($file)) {
                        push(@hasmain, $fil);
                     } else {
                        push(@nomain, $fil);
                     }
                  }
               }
            }
            prt( "Without main ".scalar @nomain." ...\n" );
            foreach $fil (@nomain) {
               prt( " $fil\n" );
            }
            prt( "WITH main ".scalar @hasmain." ...\n" );
            foreach $fil (@hasmain) {
               prt( " $fil\n" );
            }
         }
      } else {
         for ($i = 0; $i < $ac; $i++) {
            if ($all_files[$i][3] == 1) {
               if ($all_files[$i][2] == 0) {
                  $file = $all_files[$i][1];
                  $fil = sub_root($file);
                  $omsg = " $fil ";
                  prt( "$omsg\n" );
               }
            }
         }
      }
      prt( "Above $mc Sources NOT INCLUDED in $msg ...\n\n" );
   }
}
sub sub_common_folder {
   my ($f1, $f2) = @_;
   my $off = 0;
   my $df1 = lc(unix_2_dos($f1));
   my $df2 = lc(unix_2_dos($f2));
   while ( substr($df1,$off,1) &&
         substr($df2,$off,1) &&
         ( substr($df1,$off,1) eq substr($df2,$off,1) ) ) {
      $off++;
   }
   return substr($f1,$off);
}
# exclude the ROOT FOLDER,
# if there is a $root_dir,
# and this file BEGINS with that root!
sub sub_root {
   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;
}
# eof - vc6srcs01.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional