#!/perl -w # NAME: findinc.pl # AIM: Scan all 'system' headers to find input string ... # 17/05/2012 - delete (unlink) batch and text when done # 03/03/2012 - Add -exact, to match EXACTLY. # 11/09/2011 - Exit if no FIND given, and added version, add $verbosity, and quieten output # 12/11/2009 - Minor enhancement - show number of file containing find # 2009-07-09 - minor enhancement to show ALL include files searched use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) unshift(@INC, 'C:/GTools/perl'); require 'fgutils02.pl' or die "Unable to load fgutils02 ...\n"; # require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; # log file stuff my ($LF); my $perl_base = "C:\\GTools\\perl"; my $pgmname = $0; if ($pgmname =~ /(\\|\/)/) { my @tmpsp = split(/(\\|\/)/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $perl_base."\\temp.$pgmname.txt"; open_log($outfile); ###prt( "$0 ... Hello, World ...\n" ); my $VERS = "1.0.4 2014-12-27"; ###my $VERS = "1.0.3 2012-05-17"; # check ENVIRONMENT for this my $include = 'INCLUDE'; # ================================================================ # FIND STRING # ================================================================ # FIND THIS my $debug_on = 0; my $def_find = "SH_DENYNO"; ##my $find = 'pton'; # inet_pton'; ##my $find = 'WEXITSTATUS'; ##my $find = "httpserv.h"; ##my $find = "http.h"; ##my $find = "NTDDI_VERSION"; ##my $find = "INT32"; ##my $find = "EINPROGRESS"; ##my $find = "_WIN32"; ##my $find = 'time_t'; ##my $find = '__time_t'; ##my $find = 'major_t'; # hmmm, does NOT exist in unix headers, but is defined as 'int' in a autogen config.h or tar 1.20 ##my $find = 'EINVAL'; ##my $find = 'size_t'; # NUMEROUSE ##my $find = 'CP_UTF8'; # WinNls.h (101) ##my $find = 'execvp'; ##my $find = 'uintmax_t'; ##my $find = 'mkdir'; ##my $find = 'F_OK'; ##my $find = 'getline'; ###my $find = 'group'; ###my $find = 'passwd'; ##my $find = 'F_GETFD'; ##my $find = 'major_t'; ##my $find = 'S_IRWXUGO'; ##my $find = 'UINTMAX_MAX'; ##my $find = 'S_ISUID'; ###my $find = 'S_IFDIR'; ###my $find = 'S_ISDIR'; ###my $find = 'S_IRUSR'; ###my $find = 'option'; ###my $find = '__dirstream'; ###my $find = 'DIR'; ##my $find = 'STD_ERROR_HANDLE'; ##my $find = "EINTR"; ##my $find = "O_BINARY"; ##my $find = "MAX_"; ##my $find = "SSIZE_T"; ##my $find = "_CRT_DOUBLE"; ##my $find = "off_t"; # typedef long off_t #define _OFF_T_DEFINED wchar.h & sys\types.h #my $find = 'FILE_OFFSET_BITS'; ##my $find = 'LARGE_FILES'; ##my $find = 'HANDLE'; ##my $find = "WIN64"; ##my $find = '_INTEGRAL_MAX_BITS'; ##my $find = '_USE_32BIT_TIME_T'; ##my $find = 'intptr_t'; ##my $find = '_stati64'; ##my $find = 'uint32_t'; ##my $find = 'stat.inl'; ##my $find = 'UNREFERENCED_PARAMETER'; ##my $find = '220326'; ##my $find = 'SRCINVERT'; ##my $find = "WM_MOUSEMOVE"; ##my $find = '_CRT_SECURE_NO_DEPRECATE'; ##my $find = '_MRTIMP'; ##my $find = 'FILETIME'; ##my $find = '_S_IWRITE'; ##my $find = 'POLLFD'; ##my $find = 'timespec'; ###my $find = 'timeval'; ###my $find = 'CLSID'; ###my $find = "NTSTRSAFE_H_INCLUDED"; ###my $find = "strto"; ###my $find = "_CRT_NONSTDC_DEPRECATE"; ###my $find = "stricmp"; ###my $find = "INVALID_SOCKET"; ###my $find = "HINTERNET"; ###my $find = "PHTTP_REQUEST"; ###my $find = 'EINTR'; ###my $find = 'WINAPI'; ###my $find = 'socklen_t'; ###my $find = '64-bit'; ###my $find = 'LONGLONG'; my $find_stg = ''; my $find = ''; # FEATURES my $verbosity = 0; my $whole = 1; my $exact = 0; my $nocase = 1; my $shownotwhole = 0; my $add_unix_includes = 0; # include Ubuntu /usr/include list - in my C:\Projects\include ... my $use_unix_only = 0; my $unix_includes = 'C:\Projects\include'; my $add_unix_apple = 0; # include APPLE includes, from Louis machine my $apple_incs = "C:\\DTEMP\\usr\\include"; my $incddk = 0; my $trimall = 1; # show only the trim_all line my $showprocessed = 0; # show "$fold_count: Processed: [$inf] ... $hfcnt files, $lncnt lines, $fndcnt finds ... my $exclude_comments = 1; # default to ON - do NOT search comments my $maxlines = 200000; my $showincs = 1; # at end show list of ALL include files searched my $showincsfull = 1; # show FULL path of include searched my $load_log = 0; # load LOG file at end my $show_no_find_list = 0; # special debug - search just ONE file my $one_file = ''; #my $one_file = 'C:\Program Files\Microsoft Platform SDK for Windows Server 2003 R2\Include\BaseTsd.h'; # program variables my @found = (); my @foundtd = (); my @foundif = (); my @foundit = (); my @folders = (); my @functions = (); my %vc8_hash = (); my $vc8_dir = 'C:\Program Files\Microsoft Visual Studio 8\VC\vcpackages\vcprojectengine.dll.config'; my @vc8_incs = (); my @vc8_found = ( 'C:\Program Files\Microsoft Platform SDK for Windows Server 2003 R2\Include', # 907 File(s) 51,017,044 bytes 'C:\Program Files\Debugging Tools for Windows\sdk\inc', # 4 File(s) 780,272 bytes 'C:\Program Files\Debugging Tools for Windows\winext\manifest', # 32 File(s) 1,264,957 bytes 'C:\Program Files\Microsoft DirectX SDK (October 2006)\Include', # 82 File(s) 3,511,805 bytes 'C:\Program Files\Microsoft DirectX SDK (October 2006)\Samples\C++\Common', # 9 File(s) 135,789 bytes 'C:\Program Files\Microsoft DirectX SDK (October 2006)\Samples\C++\DXUT\Core', # 3 File(s) 56,644 bytes 'C:\Program Files\Microsoft DirectX SDK (October 2006)\Samples\C++\DXUT\Optional', # 8 File(s) 111,530 bytes 'C:\Program Files\Microsoft DirectX SDK (October 2006)\Samples\C++\Misc\DxDiagReport', # 10 File(s) 23,610 bytes 'C:\Program Files\Microsoft Platform SDK for Windows Server 2003 R2\Include\atl', # 13 File(s) 1,512,619 bytes 'C:\Program Files\Microsoft Platform SDK for Windows Server 2003 R2\Include\crt', # 65 File(s) 608,821 bytes 'C:\Program Files\Microsoft Platform SDK for Windows Server 2003 R2\Include\crt\sys', # 5 File(s) 12,467 bytes 'C:\Program Files\Microsoft Platform SDK for Windows Server 2003 R2\Include\gl', # 3 File(s) 99,389 bytes 'C:\Program Files\Microsoft Platform SDK for Windows Server 2003 R2\Include\mfc', # 44 File(s) 962,431 bytes #'C:\Program Files\Microsoft Platform SDK for Windows Server 2003 R2\misc\Include Updates', # 1 File(s) 138,296 bytes 'C:\Program Files\Microsoft Platform SDK for Windows Server 2003 R2\src\crt', # 79 File(s) 474,787 bytes 'C:\Program Files\Microsoft Platform SDK for Windows Server 2003 R2\src\crt\sys', # 5 File(s) 15,741 bytes 'C:\Program Files\Microsoft Platform SDK for Windows Server 2003 R2\src\mfc', # 21 File(s) 644,692 bytes 'C:\Program Files\Microsoft SQL Server\90\SDK\Include', # 4 File(s) 169,617 bytes 'C:\Program Files\Microsoft Visual Studio 8\VC\include', # 72 File(s) 1,284,522 bytes 'C:\Program Files\Microsoft Visual Studio 8\VC\include\msclr', # 8 File(s) 151,706 bytes 'C:\Program Files\Microsoft Visual Studio 8\VC\include\sys', # 5 File(s) 17,462 bytes ); my @vc10_found = ('C:\Program Files (x86)\Microsoft Visual Studio 10.0\VC\include' ); my @ddk_dirs = ( 'C:\WINDDK\inc\wxp', # 259 File(s) 14,038,709 bytes 'C:\WINDDK\inc\wnet', #277 File(s) 14,783,122 bytes 'C:\WINDDK\inc\crt', # 66 File(s) 687,162 bytes 'C:\WINDDK\inc\crt\gl', # 3 File(s) 99,395 bytes 'C:\WINDDK\inc\crt\sys' ); # 5 File(s) 12,477 bytes # debug # ######################################### my $dbg1 = 0; # show all config lines my $dbg2 = 0; # show 'Processing ...' my $dbg3 = 0; # show expansionss ... my $dbg4 = 0; # show vc8 BAT loading ... my $dbg5 = 0; # show folder about to be searched my $dbg6 = 0; # show NOT found in environment my $dbg7 = 0; # show "INCLUDE=[$iln] ... my $dbg8 = 0; # show "Count ".scalar @v8." others ... my $dbg10 = 0; # show "Warnings: Failed to OPEN [$inf] ... my $dbg11 = 0; # show "WARNING: $of is NOT a valid folder ... check name, location ... my $dbg12 = 0; # show ALL file lines prt("$line\n") - VERY NOISY my $dbg13 = 0; # show prt("FOUND $find, between [$bgn] and [$end]\n") if ($dbg13); my $dbg_f14 = 0; # prt( "[dbg_f14] Got $tmp lines, from $fil...\n" ) if ($dbg_f14); my $dbg_f15 = 0; # prt( "[dbg_f15] $lnn: $ln\n" ) if ($dbg_f15); my $dbg_f16 = 0; # prt("[dbg_f16] Added folder [$d2] $var=$val\n") if ($dbg_f16); my $dbg_f17 = 0; # prt("[dbg_f17] Folder [$d2] already in list.\n") if ($dbg_f17); my $dbg_f18 = 0; # prt("[dbg_f18] NOTE: Line [$ln] skipped\n") if ($dbg_f18); # ######################################### my $file = ''; my $fold_count = 0; my $file_lines = 0; my $total_lines = 0; my $find_count = 0; my $tot_finds = 0; my $tot_files = 0; my $last_file = ''; my $tot_folder_count = 0; my $tot_line_count = 0; my $tot_file_count = 0; my $tot_files_with_found = 0; my %incs_searched = (); my %incs_searched_full = (); my %files_searched_nc = (); my %dirs_4_search_nc = (); my %lines_fnd_in_files = (); my @warnings = (); # forward references sub set_found_in_files_count(); sub VERB1() { return ($verbosity >= 1); } sub VERB2() { return ($verbosity >= 2); } sub VERB5() { return ($verbosity >= 5); } sub VERB9() { return ($verbosity >= 9); } sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } sub show_warnings() { if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS ...\n" ); foreach my $line (@warnings) { prt("$line\n" ); } } else { ###prt("No warnings issued.\n\n"); } } sub pgm_exit($$) { my ($val,$msg) = @_; show_warnings(); #my $dbs = fgs_get_dbg_stg(); #my $dbs = svc_get_dbg_stg(); #prt("WARNING: Debug is ON for [$dbs], in fgscanvc03.pl\n" ) if (length($dbs)); #$dbs = get_sl_debug_stg(); #prt("WARNING: Debug is ON for [$dbs], in $pgmname\n" ) if (length($dbs)); if (length($msg)) { $msg .= "\n" if ( !($msg =~ /\n$/) ); prt($msg); } close_log($outfile,$load_log); # unlink($outfile); # delete output file exit($val); } sub add_to_files_nc($$) { my ($fil,$rarr) = @_; my $lcfil = lc($fil); return 1 if (defined ${$rarr}{$lcfil}); ${$rarr}{$lcfil} = $fil; return 0; } # add to files searched (nc) # return 1, if already searched # else add it, nad return zero. sub add_to_files_searched($) { my ($fil) = shift; return add_to_files_nc($fil,\%files_searched_nc); } sub get_include_dirs($) { my ($rs) = @_; #if ( length($vs_install_directory) ) { # ${$rs} = $vs_install_directory; # return 1; #} my $bfil = get_vs_vars_bat(); ## like 'C:\Program Files\Microsoft Visual Studio 9.0\VC\vcvarsall.bat'; my $fil = 'temptempvc.txt'; my $bat = 'temptempvc.bat'; my $iret = 0; unlink $fil if (-f $fil); unlink $bat if (-f $bat); my %d_added = (); my $rda = \%d_added; if (-f $bfil) { my $msg = '@call "'.$bfil.'" x86 >nul'."\n"; $msg .= "\@echo VSINSTALLDIR=\%VSINSTALLDIR\% >$fil\n"; # $(WindowsSdkDir)\include $msg .= "\@echo WindowsSdkDir=\%WindowsSdkDir\% >>$fil\n"; # $(FrameworkSDKDir)include $msg .= "\@echo FrameworkSDKDir=\%FrameworkSDKDir\% >>$fil\n"; # C:\Program Files\Microsoft DirectX SDK (March 2008)\Include # maybe HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\Environment # DXSDK_DIR=C:\Program Files\Microsoft DirectX SDK (March 2008)\ so... $msg .= "\@echo DXSDK_DIR=\%DXSDK_DIR\% >>$fil\n"; # ALL INCLUDE items $msg .= "\@echo INCLUDE=\%INCLUDE\% >>$fil\n"; write2file($msg,$bat); system($bat); # run it my ($ln,@arr,@dirs,$tmp,$var,$val,@arr2,$d2,$lnn); if (open INF, "<$fil") { @arr = ; close INF; @dirs = (); $tmp = scalar @arr; prt( "[dbg_f14] Got $tmp lines, from $fil...\n" ) if ($dbg_f14); $lnn = 0; foreach $ln (@arr) { chomp $ln; $ln = substr($ln,0,length($ln)-1) while ($ln =~ /\s$/); $lnn++; prt( "[dbg_f15] $lnn: $ln\n" ) if ($dbg_f15); if ($ln =~ /(\w+)=(.+)/) { $var = $1; $val = $2; prt( "$lnn: $var=$val\n" ) if ($dbg_f15); if ($var eq 'INCLUDE') { @arr2 = split(";",$val); $tmp = scalar @arr2; # prt( "Got $tmp INCLUDE items...\n" ); foreach $d2 (@arr2) { if (-d $d2) { if (add_to_files_nc($d2,$rda)) { prt("[dbg_f17] Folder [$d2] already in list.\n") if ($dbg_f17); } else { push(@dirs,$d2); prt("[dbg_f16] Added folder [$d2] $var\n") if ($dbg_f16); } } else { prt("NOTE: Can NOT locate folder [$d2] $var\n") if (VERB9()); } } } elsif ($var eq 'VSINSTALLDIR') { $d2 = "$val"; $d2 .= "\\" if (!($d2 =~ /(\\|\/)$/)); $d2 .= "VC\\include"; if (-d $d2) { if (add_to_files_nc($d2,$rda)) { prt("[dbg_f17] Folder [$d2] already in list.\n") if ($dbg_f17); } else { push(@dirs,$d2); prt("[dbg_f16] Added folder [$d2] $var=$val\n") if ($dbg_f16); } } else { prt("NOTE: Can NOT locate folder [$d2] $var=$val\n") if (VERB9()); } } elsif ($var eq 'WindowsSdkDir') { $d2 = "$val"; $d2 .= "\\" if (!($d2 =~ /(\\|\/)$/)); $d2 .= "include"; if (-d $d2) { if (add_to_files_nc($d2,$rda)) { prt("[dbg_f17] Folder [$d2] already in list.\n") if ($dbg_f17); } else { push(@dirs,$d2); prt("[dbg_f16] Added folder [$d2] $var=$val\n") if ($dbg_f16); } } else { prt("NOTE: Can NOT locate folder [$d2] $var=$val\n") if (VERB9()); } } elsif ($var eq 'FrameworkSDKDir') { $d2 = "$val"; $d2 .= "\\" if (!($d2 =~ /(\\|\/)$/)); $d2 .= "include"; if (-d $d2) { if (add_to_files_nc($d2,$rda)) { prt("[dbg_f17] Folder [$d2] already in list.\n") if ($dbg_f17); } else { push(@dirs,$d2); prt("[dbg_f16] Added folder [$d2] $var=$val\n") if ($dbg_f16); } } else { prt("NOTE: Can NOT locate folder [$d2] $var=$val\n") if (VERB9()); } } elsif ($var eq 'DXSDK_DIR') { $d2 = "$val"; $d2 .= "\\" if (!($d2 =~ /(\\|\/)$/)); $d2 .= "include"; if (-d $d2) { if (add_to_files_nc($d2,$rda)) { prt("[dbg_f17] Folder [$d2] already in list.\n") if ($dbg_f17); } else { push(@dirs,$d2); prt("[dbg_f16] Added folder [$d2] $var=$val\n") if ($dbg_f16); } } else { prt("NOTE: Can NOT locate folder [$d2] $var=$val\n") if (VERB9()); } } } else { prt("[dbg_f18] NOTE: Line [$ln] skipped\n") if ($dbg_f18); } } $tmp = scalar @dirs; prt( "get_include_dirs: return $tmp dirs...\n" ); ${$rs} = [ @dirs ]; $iret = 1; } else { prtw("ERROR: Failed to open [$fil]!!!\n"); } } else { prtw( "ERROR: Failed to find [$bfil]!\n" ); } unlink $fil if (-f $fil); unlink $bat if (-f $bat); return $iret; } sub show_file_list() { # if (VERB1()); my ($ff,$rla,$nam,$dir,$rfa,$dcnt); my %folds = (); my @arr = sort keys(%lines_fnd_in_files); my $cnt = scalar @arr; prt("\nSorting $cnt files per directory...\n") if ($cnt); foreach $ff (@arr) { $rla = $lines_fnd_in_files{$ff}; $cnt = scalar @{$rla}; #my ($nam,$dir,$ext) = fileparse($ff, qr/\.[^.]*/); ($nam,$dir) = fileparse($ff); $folds{$dir} = [] if (!defined $folds{$dir}); $rfa = $folds{$dir}; push(@{$rfa},"$nam($cnt)"); } $dcnt = 0; foreach $dir (keys %folds) { $dcnt++; $rfa = $folds{$dir}; prt("Directory:$dcnt: $dir\n"); @arr = sort @{$rfa}; $cnt = scalar @arr; prt("Found:$cnt: ".join(", ",@arr)."\n"); } } parse_args(@ARGV); prt( "Finding [$find] ... " ); show_config(); my $envstg = $ENV{$include}; if (defined $envstg) { my @ar = split(';',$envstg); foreach my $it (@ar) { if (length($it)) { if (($it eq '.')||($it eq '..')) { next; } if (-d $it) { add_sub_directories($it); } } } } else { prt( "$include NOT found in environment ...\n" ) if ($dbg6); } my $vc8_env = $ENV{"VS80COMNTOOLS"}; if (defined $vc8_env) { # we have MSVC8 my $vc8_bat = $vc8_env . "vsvars32.bat"; if (-f $vc8_bat) { load_vc8_bat($vc8_bat); } else { prt( "WARNING: [$vc8_bat] not found ...\n" ); } } my @v8 = get_vc8_dirs(); if ($incddk) { push(@v8, @ddk_dirs); } prt( "[dbg8] Count ".scalar @v8." others ...\n" ) if ($dbg8); foreach my $d (@v8) { ###add_folder_includes($d); if (length($d)) { next if (($d eq '.')||($d eq '..')); if (-d $d) { add_sub_directories($d); } } } add_folder_includes( $apple_incs ) if ($add_unix_apple); if ($add_unix_includes) { @folders = () if ($use_unix_only); add_folder_includes( $unix_includes ) } my $fdrcnt = scalar @folders; prt( "Will search (up to) $fdrcnt folders ...\n" ); if ($dbg5) { foreach $file (@folders) { prt( "$file\n" ); } } if (length($one_file)) { if ( process_file($one_file) ) { $total_lines += $file_lines; #$lncnt += $file_lines; #$fndcnt += $find_count; $tot_finds += $find_count; } } else { # do the folder search foreach $file (@folders) { if ($file eq $unix_includes) { prt( "Commencing UNIX includes ($file) ...\n" ); } elsif ($file eq $apple_incs) { prt( "Commencing APPLE includes ($file) ...\n" ); } process_folder($file); } } prt( "Done $tot_line_count lines ... $tot_file_count files, $tot_folder_count folders ...\n" ); set_found_in_files_count(); # added 2009/11/20 show_incs_searched(); # added 2009-07-08 my $itcnt = scalar @foundit; my $fcnt = scalar @found; my $tcnt = scalar @foundtd; my $icnt = scalar @foundif; my $funccnt = scalar @functions; my $donecnt = 0; # output of FINDS if ($itcnt) { prt( "\nFound $itcnt ... not define, typedef, ...\n" ); foreach $file (@foundit) { prt( "$file\n" ); $donecnt++; } } if ($fcnt) { prt( "\nFound $fcnt with #define ...\n" ); foreach $file (@found) { prt( "$file\n" ); $donecnt++; } } if ($tcnt) { prt( "\nFound $tcnt with typedef ...\n" ); foreach $file (@foundtd) { prt( "$file\n" ); $donecnt++; } } if ($icnt) { prt( "\nFound $icnt with #if ...\n" ); foreach $file (@foundif) { prt( "$file\n" ); $donecnt++; } } if ($funccnt) { prt( "\nFound $funccnt functions ...\n" ); foreach $file (@functions) { prt("$file "); $donecnt++; } } prt( "No special finds ...\n" ) if (!$donecnt); show_file_list() if (VERB1()); # FINAL OUTPUT SUMMARY prt( "\n" ); prt( "In finding [$find] ... with " ); show_config(); prt( "Processed $fold_count folders, $tot_files files, $total_lines lines, $tot_finds finds, in $tot_files_with_found files ...\n" ); prt( "\n" ); pgm_exit(0, "Normal exit."); ##################################################################### sub add_2_folders { my ($dir) = shift; my $lcd = lc($dir); foreach $file (@folders) { my $lcf = lc($file); if ($lcd eq $lcf) { return; } } push(@folders, $dir); } sub add_sub_directories { my ($inf) = shift; if ( opendir( DIR, $inf ) ) { add_2_folders( $inf ) ; my @fils = readdir(DIR); closedir DIR; foreach my $fil (@fils) { next if (($fil eq '.')||($fil eq '..')); my $ff = $inf; $ff .= "\\" if !($ff =~ /(\\|\/)$/ ); $ff .= $fil; if (-d $ff) { add_2_folders($ff); } } } else { prt( "WARNING: Can NOT open $inf ...\n" ); } } sub add_folder_includes { my ($of) = shift; if (-d $of) { add_sub_directories( $of ); } else { prt( "WARNING: $of is NOT a valid folder ... check name, location ...\n" ) if ($dbg11); } } sub load_vc8_cfg { my ($vc8c) = shift; if (open INF, "<$vc8c") { my @clns = ; close INF; foreach my $cln (@clns) { chomp $cln; $cln = trim_all($cln); prt( "$cln\n" ) if ($dbg1); if ($cln =~ /include=\"(.+)\"/i) { my $iln = $1; my @vc8i = split(';',$iln); prt( "INCLUDE=[$iln]\n" ) if ($dbg7); foreach my $itm (@vc8i) { push(@vc8_incs, $itm); } } } } else { prt( "WARNING: can not open [$vc8c] ... $! ...\n" ); } } sub load_vc8_bat { my ($vc8b) = shift; if (open INB, "<$vc8b") { my @lns = ; close INB; foreach my $ln (@lns) { chomp $ln; $ln = trim_all($ln); if ($ln =~ /\@*SET\s+(.*)/) { my @arr = split(/=/,$1); my $sz = scalar @arr; if ($sz == 2) { my $ky = uc($arr[0]); my $val = $arr[1]; $vc8_hash{$ky} = $val; prt( "[$ky]=[$val]\n" ) if ($dbg4); if ($ky =~ /^VCINSTALLDIR$/i) { # got the INSTALL DIECTORY my $vc8_cfg = $val. "\\vcpackages\\vcprojectengine.dll.config"; if (-f $vc8_cfg) { load_vc8_cfg($vc8_cfg); } else { prt( "WARNING: [$vc8_cfg] does not exist ...\n" ); } } } else { prt( "SET $1\n" ); } } } foreach my $item (@vc8_incs) { # expand if ($item =~ /.*\$\((.+)\).+/) { my $eit = uc($1); prt( "Item [$eit] in [$item] needs expansion ...\n" ) if ($dbg3); foreach my $key (keys %vc8_hash) { if ($key eq $eit) { $item =~ s/\$\($key\)/$vc8_hash{$key}\\/i; prt( "New item = [$item] ...\n" ) if ($dbg3); last; } } } ###push(@folders, $item) if (length($item)); add_folder_includes( $item ) if (length($item)); } } else { prt( "WARNING: No open of [$vc8b] ... $! ...\n" ); } } sub is_whole_test { my ($ln) = shift; if ($ln eq $find) { return 1; } my $ind = index($ln, $find); if ($ind >= 0) { if ($ind == 0) { my $bal = substr($ln,length($find)); if ($ln =~ /^$find[\s\),;\*_]+/) { return 1; } } else { if ($ln =~ /[\s\(,;\*_]+$find[\s\),;\*_]+/) { return 1; } } } return 0; } sub is_whole_test_nc { my ($ln) = shift; my $lcln = lc($ln); my $lcfd = lc($find); if ($lcln eq $lcfd) { return 1; } my $ind = index($lcln, $lcfd); if ($ind >= 0) { if ($ind == 0) { my $bal = substr($lcln,length($lcfd)); if ($lcln =~ /^$lcfd[\s\),;\*_]+/) { return 1; } } else { if ($lcln =~ /[\s\(,;\*_]+$lcfd[\s\),;\*_]+/) { return 1; } } } return 0; } sub is_whole { my ($ln) = shift; my ($bgn, $end, $ord); my $found = 0; if ($nocase) { # 2009-07-08 - do this check first - case sensitive if (is_whole_test_nc($ln)) { return 1; } if ( $ln =~ /^(.*)$find(.*)$/i ) { $bgn = $1; $end = $2; $found = 1; } } else { # 2009-07-08 - do this check first - case sensitive if (is_whole_test($ln)) { return 1; } if ( $ln =~ /^(.*)$find(.*)$/ ) { $bgn = $1; $end = $2; $found = 1; } } if ($found) { $ord = length($bgn); if ($ord >= 0) { ###my $bgn = substr($ln,0,$ord); ###my $end = substr($ln,$ord+length($find)); my $bl = length($bgn); my $el = length($end); if ( ($bl == 0) && ($el == 0) ) { #prt( "Found $find in $line ...index $ord ... [NULL], [NULL]\n" ); return 1; # whole in that it is the ONLY word in the line } elsif ( $bl && $el ) { # got BEGIN and END if ( !($bgn =~ /\w$/) && !($end =~ /^\w/) ) { #prt( "Found $find in $line ...index $ord... [$bgn], [$end]\n" ); return 1; } } elsif ( $bl ) { # only $bl if ( !($bgn =~ /\w$/) ) { #prt( "Found $find in $line ...index $ord... [$bgn], [NULL]\n" ); return 1; } } else { # got $el if ( !($end =~ /^\w/) ) { #prt( "Found $find in $line ...index $ord... [NULL], [$end]\n" ); return 1; } } } } return 0; } sub is_exact { my ($ln) = shift; if (is_whole($ln)) { if ($nocase) { if ( $ln =~ /\b$find\b/i ) { return 1; } } else { if ( $ln =~ /\b$find\b/ ) { return 1; } } } return 0; } sub C_comment_starts { my ($txt) = shift; my $len = length($txt); my $ptxt = ''; my $ttxt = ''; my ($k, $ch, $pch, $k2, $nch); for ($k = 0; $k < $len; $k++) { $k2 = $k + 1; $ch = substr($txt,$k,1); $nch = (($k2 < $len) ? substr($txt,$k2,1) : ''); if (($ch eq '/')&&($nch eq '*')) { $ttxt = substr($txt,($k2+1)); return $k2, $ptxt, $ttxt; # return offset, previous and begin comment } $pch = $ch; $ptxt .= $ch; } return 0, $ptxt, $ttxt; } sub inline_comment_starts { my ($txt) = shift; my $len = length($txt); my $ptxt = ''; my ($k, $ch, $pch, $k2, $nch); for ($k = 0; $k < $len; $k++) { $k2 = $k + 1; $ch = substr($txt,$k,1); $nch = (($k2 < $len) ? substr($txt,$k2,1) : ''); if (($ch eq '/')&&($nch eq '/')) { return $k2, $ptxt; # return offset, previous } $pch = $ch; $ptxt .= $ch; } return 0, $ptxt; } sub C_comment_ends { my ($txt) = shift; my $len = length($txt); my $ttxt = ''; my ($k, $ch, $pch, $k2, $nch); for ($k = 0; $k < $len; $k++) { $k2 = $k + 1; $ch = substr($txt,$k,1); $nch = (($k2 < $len) ? substr($txt,$k2,1) : ''); if (($ch eq '*')&&($nch eq '/')) { $ttxt = substr($txt,($k2+1)); return $k2, $ttxt; # return trailing } $pch = $ch; } return 0, $ttxt; } sub remove_comments { my (@lns) = @_; my @nlns = (); my ($ise, $atxt, $ctxt); my ($isc,$ptxt,$ttxt); my $incomm = 0; foreach my $ln (@lns) { chomp $ln; if ($incomm) { ($ise,$atxt) = C_comment_ends($ln); if ($ise) { $incomm = 0; $ctxt = trim_all($atxt); if (length($ctxt)) { $ln = $ctxt; } else { next; } } else { next; } } ($isc,$ptxt,$ttxt) = C_comment_starts($ln); if ($isc) { # C comment starting ... ($ise,$atxt) = C_comment_ends($ttxt); if ($ise) { $ptxt = trim_all($ptxt); $atxt = trim_all($atxt); $ctxt = $ptxt; # get any PREVIOUS, to /* commant start $ctxt .= ' ' if (length($ctxt) && length($atxt) && ($atxt ne ';')); $ctxt .= $atxt if length($atxt); # add any AFTER */ text $ctxt = trim_all($ctxt); if (length($ctxt)) { $ln = $ctxt; # got some TAIL text } else { next; # else nothing after */ on this line - goto NEXT } } else { $incomm = 1; # line contains '/*' comment start ... $ptxt = trim_all($ptxt); # trim any previous if (length($ptxt)) { $ln = $ptxt; # keep the previous } else { next; # else go to NEXT line } } } else { ($isc,$ptxt) = inline_comment_starts($ln); if ($isc) { $ctxt = trim_all($ptxt); if (length($ctxt)) { $ln = $ctxt; } else { next; # got no previous to '//' start } } } push(@nlns, $ln) if length($ln); } return @nlns; } sub process_file { my ($ff) = shift; my $iret = 0; my ($bgn, $end, $lbgn, $lend, $fcnt, $pcnt, $rla); $file_lines = 0; return 1 if (add_to_files_searched($ff)); # return OK, if already searched if (open INF, "<$ff") { my @lines = ; close INF; $tot_file_count++; $iret = 1; my $lnno = 0; $fcnt = 0; # find count for THIS file # PROCESS FILE LINE BY LINE ########################### @lines = remove_comments(@lines) if ($exclude_comments); foreach my $line (@lines) { $tot_line_count++; prt( "Done $tot_line_count lines ... $tot_file_count files, $tot_folder_count folders ...\n" ) if (($tot_line_count % $maxlines) == 0); $lnno++; chomp $line; $line = trim_all($line) if ($trimall); prt("$line\n") if ($dbg12); my $fnd = 0; my $fnd2 = 0; my $found = 0; if ($nocase) { if ( $line =~ /^(.*)$find(.*)$/i ) { $bgn = $1; $end = $2; $found = 1; prt("FOUND $find (NC), between [$bgn] and [$end]\n") if ($dbg13); } } else { if ( $line =~ /^(.*)$find(.*)$/ ) { $bgn = $1; $end = $2; $found = 1; prt("FOUND $find, between [$bgn] and [$end]\n") if ($dbg13); } } if ($found) { $fnd2 = 1; # if it FOUND in the LINE, at least if ($exact) { if (is_exact($line)) { $fnd = 1; } } elsif ($whole) { ###if ($line =~ /[\s\(,;\*_]*$find[\s\),;_]+/) { if (is_whole($line)) { $fnd = 1; } } else { $fnd = 1; } } if ($fnd) { $find_count++; $fcnt++; $lines_fnd_in_files{$ff} = [] if (!defined $lines_fnd_in_files{$ff}); $rla = $lines_fnd_in_files{$ff}; push(@{$rla},[$lnno,$line]); # store the line per files name if ($line =~ /#\s*define/) { push(@found, "$line - $ff ($lnno)"); } elsif ($line =~ /typedef\s+/) { push(@foundtd, "$line - $ff ($lnno)"); } elsif ($line =~ /#\s*if\w*\s*/) { push(@foundif, "$line - $ff ($lnno)"); } else { push(@foundit, "$line - $ff ($lnno)"); } prt( "File: [$ff]\n" ) if ($last_file ne $ff); prt( " $lnno: [$line]\n" ); $last_file = $ff; } elsif ($fnd2) { if ($shownotwhole) { prt( "NOT WHOLE [$line] - $ff ($lnno)\n" ); } } if (($fnd || $fnd2)&&($find eq "_CRT_NONSTDC_DEPRECATE")) { if ($line =~ /_CRT_NONSTDC_DEPRECATE\((\w+)\)\s+/) { my $func = $1; $func = substr($func,1) if ($func =~ /^_/); prt( "$func\n" ); push(@functions, $func); } } } # AFTER the search, keep the counts per file if ($showincs) { # at end show list of ALL include files searched if (defined $incs_searched_full{$ff}) { $pcnt = $incs_searched_full{$ff}; $incs_searched_full{$ff} = $fcnt if ($fcnt > $pcnt); } else { $incs_searched_full{$ff} = $fcnt; } my ($f,$d) = fileparse($ff); if (defined $incs_searched{$f}) { $pcnt = $incs_searched{$f}; $incs_searched{$f} = $fcnt if ($fcnt > $pcnt); } else { $incs_searched{$f} = $fcnt; } } $file_lines = $lnno; } else { prt( "Warning: Failed to open [$ff] ...\n" ); } return $iret; } sub process_folder { my ($inf) = shift; prt( "Processing [$inf folder] ...\n" ) if ($dbg2); if ( opendir( DIR, $inf ) ) { my @files = readdir(DIR); closedir DIR; $tot_folder_count++; $fold_count++; my $hfcnt = 0; my $lncnt = 0; my $fndcnt = 0; my @subdirs = (); foreach my $fl (@files) { if (($fl eq '.') || ($fl eq '..')) { next; } my $ff = $inf; $ff .= "\\" if ( !( substr($inf,-1,1) =~ /[\\\/]+/ ) ); $ff .= $fl; if (-d $ff) { add_2_folders($ff); next; } my ($nm, $dir, $ext) = fileparse( $fl, qr/\.[^.]*/ ); my $lcext = lc($ext); if (length($ext) == 0) { ## let these through } elsif ( !(($lcext eq '.h')||($lcext eq '.hxx')||($lcext eq '.hpp')) ) { next; } $file_lines = 0; $find_count = 0; if ( process_file($ff) ) { $total_lines += $file_lines; $lncnt += $file_lines; $fndcnt += $find_count; $tot_finds += $find_count; $hfcnt++; } } $tot_files += $hfcnt; prt( "$fold_count: Processed: [$inf] ... $hfcnt files, $lncnt lines, $fndcnt finds ...\n" ) if ($showprocessed); } else { prt( "Warnings: Failed to OPEN [$inf] directory...\n" ) if ($dbg10); } } ####################### sub get_vc8_dirs { my @vc8 = (); my %dirs = (); my $rd = \%dirs; my ($dir,$cnt,$insdir); foreach $dir (@vc8_found) { if (-d $dir) { if ( add_to_files_nc($dir,$rd) ) { # already in LIST } else { push(@vc8,$dir); } } } foreach $dir (@vc10_found) { if (-d $dir) { if ( add_to_files_nc($dir,$rd) ) { # already in LIST } else { push(@vc8,$dir); } } } if (get_include_dirs(\$insdir) ) { $cnt = scalar @{$insdir}; # prt("OK got $cnt\n"); foreach $dir (@{$insdir}) { if (-d $dir) { if ( add_to_files_nc($dir,$rd) ) { # already in LIST } else { push(@vc8,$dir); } } } } else { prt("Failed to get include directories!\n"); } #return @vc8_found; return @vc8; } sub show_config { prt( "Options: "); if ($exact) { prt("exact=". ($whole ? "On" : "Off") ." " ); } else { prt("whole=". ($whole ? "On" : "Off") ." " ); } prt( " case=". ($nocase ? "Off" : "On") ." " ); prt( " ddk=" . ($incddk ? "On" : "Off") . " " ); prt( " unix=". (( $add_unix_includes && $use_unix_only ) ? "Only" : ($add_unix_includes ? "On" : "Off") . " " )); prt( " xcomm=". ($exclude_comments ? "On" : "Off") . " " ); prt( "\n" ); } sub give_help { prt( "$pgmname: [Options] find_string ...\n" ); prt( "Options: Version $VERS\n" ); prt( " -? = This brief help....\n" ); prt( " -whole = Only WHOLE (def=". ($whole ? "On" : "Off") .")\n" ); prt( " -exact = Match exactly. More than whole (def=".($exact ? "On" : "Off").")\n"); prt( " -notwhole = NOT WHOLE\n" ); prt( " -case = Case sensitive. (def=". ($nocase ? "Off" : "On") .")\n" ); prt( " -nocase = Case insensitive.\n" ); prt( " -ddk = Include DDK folders (def=". ($incddk ? "On" : "Off") . ")\n" ); prt( " -noddk = Exclude DDK folders\n" ); prt( " -unix = Include 'unix' includes (def=". ($add_unix_includes ? "On" : "Off"). " in $unix_includes )\n" ); prt( " -shownot = Show list of not found in files in full.\n"); prt( " -nounix = Exclude 'unix' folder\n" ); prt( " -ll = Load log file at end.\n" ); prt( " -v[Num] = Bump or set verbosity. Def=$verbosity - 0,1,2,5,9...\n"); prt( "The purpose is to seach the 'system' type include files for a 'word'.\n" ); exit(0); } # parse arguments ... sub parse_args { my (@av) = @_; # = (@ARGV); my $bare = 0; my ($farg,$arg,$ch); while (@av) { $arg = $av[0]; $farg = $arg; $ch = substr($arg,0,1); if (($ch eq '-')||($ch eq '/')) { $arg = substr($arg,1); $arg = substr($arg,1) while ($arg =~ /^-/); if (($arg eq '?')||($arg =~ /^h$/i)) { give_help(); } elsif ($arg eq 'whole') { $whole = 1; prt( "Setting WHOLE ...\n" ); } elsif ($arg eq 'notwhole') { $whole = 0; prt( "Setting NOT WHOLE ...\n" ); } elsif ($arg eq 'case') { $nocase = 0; prt( "Setting CASE ...\n" ); } elsif ($arg eq 'nocase') { $nocase = 1; prt( "Setting NO CASE ...\n" ); } elsif ($arg eq 'ddk') { $incddk = 1; prt( "Setting INCLUDE DDK folder ...\n" ); } elsif ($arg eq 'exact') { $exact = 1; prt( "Setting EXACT ...\n" ); } elsif ($arg eq 'noddk') { $incddk = 0; prt( "Setting NOT INCLUDE DDK folder ...\n" ); } elsif ($arg eq 'unix') { $add_unix_includes = 1; prt( "Setting INCLUDE UNIX folder ($unix_includes)...\n" ); } elsif ($arg eq 'nounix') { $add_unix_includes = 0; prt( "Setting NOT INCLUDE UNIX folder ($unix_includes)...\n" ); } elsif ($arg =~ /^v/) { # verbosity items $dbg2 = 1; # show 'Processing ...' if ($arg =~ /^v(\d+)$/) { $verbosity = $1; } else { while ($arg =~ /^v/) { $verbosity++; $arg = substr($arg,1); } } prt( "Set to show 'Processing...' verbosity=$verbosity\n" ) if (VERB1()); } elsif ($arg eq 'shownot') { $show_no_find_list = 1; prt( "set to show not found file list in full...\n"); } elsif ($arg eq 'll') { $load_log = 1; prt( "Set to show log file at end.\n"); } else { prt( "ERROR: Unknown option -$arg ...\n" ); give_help(); } } else { if ($bare) { prt("ERROR: 2nd bare find argument [$arg]!\n"); prt("Already have [$find]!\n"); exit(1); } $find = $arg; $find_stg = $arg; prt( "Setting FIND to [$find] ...\n" ); $bare++; } shift @av; } if ($debug_on) { if (length($find_stg) == 0) { $find = $def_find; $find_stg = $def_find; prt( "Setting DEFAULT FIND to [$find] ...\n" ); } } if (length($find_stg) == 0) { pgm_exit(1,"ERROR: No find found in command! Try -?"); } } sub set_found_in_files_count() { my ($key, $val); my $fndcnt = 0; foreach $key (keys %incs_searched_full) { $val = $incs_searched_full{$key}; $fndcnt++ if ($val); } $tot_files_with_found = $fndcnt; } # show %incs_searched or %incs_searched_full ... sub show_incs_searched { my ($cnt, $key, $val, $wrap, $max, $msg, $zcnt, @sarr, $len, @sarrf); if ($showincs) { # at end show list of ALL include files searched $zcnt = 0; if ($showincsfull) { $cnt = scalar keys(%incs_searched_full); prt( "Searched $cnt files (full name) - list with NO finds.\n" ); foreach $key (sort { lc($a) cmp lc($b) } keys(%incs_searched_full)) { $val = $incs_searched_full{$key}; if ($val == 0) { prt( "$key\n" ) if ($show_no_find_list); $zcnt++; } } prt( "Done list of $zcnt files searched, with no FIND...\n" ) if ($show_no_find_list); if ($cnt > $zcnt) { @sarr = (sort { lc($a) cmp lc($b) } keys(%incs_searched_full)); prt("List of ".($cnt - $zcnt)." ($tot_files_with_found) with finds, showing find count...\n"); @sarrf = (); $wrap = 0; foreach $key (@sarr) { $val = $incs_searched_full{$key}; if ($val) { $len = length($key); $wrap = $len if ($len > $wrap); push(@sarrf,$key); } } foreach $key (@sarrf) { $val = $incs_searched_full{$key}; $msg = $key; $msg .= ' ' while (length($msg) < $wrap); prt( "$msg $val\n" ); } prt("Done list of ".($cnt - $zcnt)." with finds, showing find count...\n"); } } else { $max = 90; $cnt = scalar keys(%incs_searched); prt( "Searched $cnt files (short)\n" ); foreach $key (sort { lc($a) cmp lc($b) } keys(%incs_searched)) { $val = $incs_searched{$key}; if ($val == 0) { $zcnt++; $msg = " $key"; $wrap += length($msg); if ($wrap > $max) { $wrap = 0; prt("\n"); } prt("$msg"); } } if ($wrap) { prt("\n"); } prt( "Done list of $zcnt files searched, with no FIND...\n" ); $wrap = 0; if ($cnt > $zcnt) { foreach $key (sort { lc($a) cmp lc($b) } keys(%incs_searched)) { $val = $incs_searched{$key}; if ($val) { $msg = " $key($val)"; $wrap += length($msg); if ($wrap > $max) { $wrap = 0; prt("\n"); } prt("$msg"); } } if ($wrap) { prt("\n"); } } } prt( "Done list of $cnt files searched...\n" ); } } # eof - findinc.pl