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