#!/perl -w
# NAME: hasmain.pl
# AIM: Read a C/C++ file, and search for main() { } function ...
# 20/11/2007 - geoff mclane - http://geoffair.net/mperl
use strict;
use warnings;
require 'logfile.pl' or die "Unable to load logfile.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 @in_files = qw(
C:\FGCVS\FlightGear\source\examples\netfdm\main.cpp
C:\FGCVS\FlightGear\source\scripts\example\fgfsclient.c
C:\FGCVS\FlightGear\source\scripts\example\fgfsclient.cxx
C:\FGCVS\FlightGear\source\src\Airports\testair.cxx
C:\FGCVS\FlightGear\source\src\FDM\LaRCsim\c172_main.c
C:\FGCVS\FlightGear\source\src\FDM\LaRCsim\ls_trim.c
C:\FGCVS\FlightGear\source\src\FDM\LaRCsim\mymain.c
C:\FGCVS\FlightGear\source\src\Main\fg_os_osgviewer.cxx
C:\FGCVS\FlightGear\source\src\Main\fg_os_sdl.cxx
C:\FGCVS\FlightGear\source\src\Navaids\testnavs.cxx
C:\FGCVS\FlightGear\source\src\Network\jpg-httpd.cxx
C:\FGCVS\FlightGear\source\src\Scenery\maptest.cxx
C:\FGCVS\FlightGear\source\src\Scenery\test.cxx
C:\FGCVS\FlightGear\source\src\Time\test_event.c
C:\FGCVS\FlightGear\source\src\Time\ttest.c
C:\FGCVS\FlightGear\source\src\Time\win32test.c
C:\FGCVS\FlightGear\source\utils\Modeller\3dconvert.cxx
);

my $do_chkmain = 1;
my $in_file = "C:\\FG\\FGCOM\\curl\\docs\\examples\\cookie_interface.c";
@in_files = ($in_file);
my @missed_main = ();
###my @mains = ();
##check_for_main( $in_file );
foreach my $file (@in_files) {
	my @arr = ();
	my $mo = '';
	if ($do_chkmain) {
		if ( !chk_main( $file, \@arr ) ) {
			prt( "NOTE: NO MAIN FOUND in $file\n" );
			push(@missed_main, $file);
		} else {
			$mo = "$file - HAS MAIN";
			my $ac = scalar @arr;
			for (my $m = 0; $m < $ac; $m++) {
				$mo .= "\n  ".$arr[$m][0].": ". $arr[$m][1];
				$mo .= " cond " . $arr[$m][2] if (length($arr[$m][2]));
			}
			prt( "$mo\n" );
		}
	} else {
		my @is = get_includes($file);
		prt( "\nCount: ".scalar @is." includes in: $file\n". join(", ",@is) ."\n" );
	}
}

###if (@mains) {
###	prt( "\nSet of ".scalar @mains." found ...\n" );
###	prt( join("\n",@mains)."\n");
###}

if (@missed_main) {
	prt( "\nNOTE: ".scalar @missed_main." file with NO 'main' ...\n" );
	prt( join("\n", @missed_main)."\n\n");
}

close_log($outfile,1);
exit(0);


# remove anything trailing the included file name
sub trim_include_tail {
	my ($inc) = shift;
	my $ill = length($inc);
	my $i = 0;
	###prt( "Trimming  [$inc]$ill ...\n" );
	if ($ill) {
		my $ch = substr($inc,$i,1);
		if (($ch eq '"')||($ch eq '<')) {
			$i++;
			$ch = '>' if ($ch eq '<');
			for ( ; $i < $ill; $i++) {
				my $ch2 = substr($inc,$i,1);
				if ($ch2 eq $ch) {
					$i++;
					last;
				}
			}
			$inc = substr($inc,0,$i);
		}
	}
	###prt( "Returning [$inc]$i ...\n" );
	return $inc;
}

sub get_includes {
	my ($fil) = shift;
	my $fndm = 0;
	my ($ccnt, $pline, $j, $k, $k2, $ch, $pch, $cline, $tline, $ll, $incomm, $tag, $fnd1, $comment);
	my ($lncomm, $wascomm);
	my @incs = ();
	if (open INF, "<$fil") {
		my @clines = <INF>;
		close INF;
		$ccnt = scalar @clines;
		$incomm = 0;
		$lncomm = 0;
		###prt( "\nProcessing $ccnt lines of $fil ...\n" );
		for ($k = 0; $k < $ccnt; $k++) {
			$cline = $clines[$k];
			$k2 = $k + 1;
			chomp $cline;
			$tline = $cline;	# trim_all($cline);
			$ll = length($tline);
			if ( !$incomm && ($tline =~ /^\s*#\s*include\s+(.*)$/)) {
				push(@incs,trim_include_tail($1));
				next;	# skip '#include <main/main.h>' like INCLUDE lines
			}
			$lncomm = 0;
			$pch = '';
			for ($j = 0; $j < $ll; $j++) {
				$ch = substr($tline,$j,1);
				if ($incomm) {
					# only looking for CLOSE comment */
					if (($ch eq '/') && ($pch eq '*')) {
						$incomm = 0;
					}
				} else {
					if ($ch eq '"') {
						# start of QUOTE
						$j++;	# to next char
						$pch = $ch;
						for ( ; $j < $ll; $j++) {
							$ch = substr($tline,$j,1);
							if (($ch eq '"')&&($pch ne "\\")) {
								last;	# out of here
							}
							$pch = $ch;
						}
					} elsif (($ch eq '*') && ($pch eq '/')) {
						# comment start /* until */
						$incomm = 1;
						$wascomm = 1;
					} elsif (($ch eq '/') && ($pch eq '/')) {
						$j = $ll;	# skip rest of line
						$lncomm = 1;
					}
				}
				$pch = $ch;
			}
			###prt( "line $k2:[$tline]$ll ($incomm:$lncomm) $fnd1 $fndm\n" );
			$wascomm = $incomm;
			$pline = $cline;
		}
	} else {
		prt( "WARNING: Unable to open [$fil] file ... $! ...\n" );
	}
	return @incs;
}


# eof
