#!/perl -w # NAME: makesrcs02.pl # AIM: Read a makefile, and (hopefully) list the SOURCES # 28/08/2010 - Add more features, when using with say libxml2 makefile.msvc # 23/08/2010 - Turn OFF debug for release, and add a littel HELP # 09/08/2010 - Another try to improve the makefile scan... # 06/07/2010 - Revisit, and hopefully IMPROVE # 26/12/2007 - geoff mclane - http://geoffair.net/mperl use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use File::Spec; # File::Spec->rel2abs($rel); # we are IN the SLN directory, get ABSOLUTE from RELATIVE use Cwd; my $perl_base = 'C:\GTools\perl'; # perl directory unshift(@INC, $perl_base); #require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; require 'fgutils02.pl' or die "Unable to load fgutils02.pl ...\n"; require 'fgdsphdrs03.pl' or die "Unable to load fgdsphdrs03.pl ...\n"; require 'scanvc.pl' or die "Unable to load scanvc.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 = $perl_base."\\temp.$pgmname.txt"; open_log($outfile); my $cwd = getcwd(); # prt( "$0 ... Hello, World ... CWD: $cwd\n" ); # features my $load_log = 0; my $temp_dsp = $perl_base.'\temp2010.dsp'; my $temp_dsw = $perl_base.'\temp2010.dsw'; my $check4main = 1; # using chkmain.pl library my $max_line = 80; my $show_not_defined = 0; # show ifdef, ifndef encountered my $root_dir = ''; my $in_file = ''; my $targ_dir = ''; my $proj_name = ''; my $proj_type = "CA"; # default to console application my %makemacs = ( 'LDFLAGS' => '' ); my %obj_hash = (); my %hdr_hash = (); my %file_hash = (); my %targets = (); my %defines = ( 'MSVC' => 1 ); my %defines_seen = (); my $act_define = ''; my @def_stack = (); my @if_stack = (); my @warnings = (); my ($fil_name, $fil_dir); # forward sub get_sources($); # debug my $debug_on = 0; my $def_in_file = 'C:\Projects\libxml2\Win32\makefile.msvc'; #my $def_in_file = 'C:\Projects\shapelib-1.2.10\makefile'; my $dbg01 = 0; # show during makefile decode... my $dbg02 = 0; # show the macros collected... my $dbg03 = 0; # show details of conversion to TARGET directory (relative) my $dbg04 = 0; # show uncased lines my $dbg05 = 0; # also show uncased lines before expansion my $dbg06 = 0; # trace IF stack my $dbg07 = 0; # trace end ifeq and ifnequ my $dbg08 = 0; # trace targets my $dbg09 = 0; # output EACH line from makefile my $dbg10 = 0; # show each SUBJECT returned my $dbg11 = 0; # show line at end, before next acquired... my $dbg12 = 0; # output MISSING expansion items my $dbg13 = 0; # show each substitution made my $dbg14 = 0; # show accumulation when back slash seen sub set_debug_val($) { my ($v) = shift; $dbg01 = $v; $dbg02 = $v; $dbg03 = $v; $dbg04 = $v; $dbg05 = $v; $dbg06 = $v; $dbg07 = $v; $dbg08 = $v; $dbg09 = $v; $dbg10 = $v; } # debug sub get_dbg_var($) { my $val = shift; my $var = 'dbg'; my $res = -1; if ($val < 10) { $var .= "0$val"; } else { $var .= "$val"; } # from : http://perldoc.perl.org/functions/eval.html if (eval "defined \$$var") { $res = eval "\$$var"; } return $res; } sub get_dbg_stg() { my $s = ''; my ($i,$res,$i2); for ($i = 1; ;$i++) { $res = get_dbg_var($i); last if ($res == -1); if ($i < 10) { $i2 = "0$i"; } else { $i2 = "$i"; } if ($res) { $s .= "$i2 "; } } return $s; } sub get_dbg_range() { my ($i,$res); for ($i = 1; ;$i++) { $res = get_dbg_var($i); last if ($res == -1); } return $i - 1; } sub set_dbg_var($) { my $val = shift; my $var = 'dbg'; if ($val < 10) { $var .= "0$val"; } else { $var .= "$val"; } # from : http://perldoc.perl.org/functions/eval.html # NOT $$var++; # does not work! if (eval "defined \$$var") { eval "\$$var++"; } else { #print "ERROR: \$$var does NOT exist\n"; return 0; } return 1; } sub clear_dbg_var($) { my $val = shift; my $var = 'dbg'; if ($val < 10) { $var .= "0$val"; } else { $var .= "$val"; } # from : http://perldoc.perl.org/functions/eval.html # NOT $$var++; # does not work! if (eval "defined \$$var") { eval "\$$var = 0"; } else { #print "ERROR: \$$var does NOT exist\n"; return 0; } return 1; } sub set_all_dbg_on() { my ($i,$res); for ($i = 1; ;$i++) { $res = set_dbg_var($i); last if (!$res); } } sub set_all_dbg_off() { my ($i,$res); for ($i = 1; ;$i++) { $res = clear_dbg_var($i); last if (!$res); } } sub set_debug_on() { set_all_dbg_on(); } sub set_debug_off() { set_all_dbg_off(); } # general ##################################################################### ####### subs ####### sub prtw($) { my ($tx) = shift; $tx =~ s/\n$// if ($tx =~ /\n$/); prt("$tx\n"); push(@warnings,$tx); } sub show_warnings($) { my ($dbg) = shift; if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS ...\n" ); foreach my $line (@warnings) { prt("$line\n" ); } prt("\n"); } elsif ($dbg) { prt("\nNo warnings issued.\n\n"); } } sub pgm_exit($$) { my ($val,$msg) = @_; show_warnings( 0 ); if (length($msg)) { $msg .= "\n" if (!($msg =~ /\n$/)); prt("$msg\n"); } close_log($outfile,$load_log); # unlink($outfile); exit($val); } sub unix_2_dos($) { my ($f) = shift; $f =~ s/\//\\/g; return $f; } # fix relative path sub fix_rel($) { # fixed 26/12/2007 to remove '\\' entries my ($path) = shift; $path = unix_2_dos($path); # ensure DOS separator my @a = split(/\\/, $path); # split on DOS separator my $npath = ''; my $wmsg = ''; my $max = scalar @a; my @na = (); for (my $i = 0; $i < $max; $i++) { my $p = $a[$i]; if ($p eq '.') { # ignore this } elsif ($p eq '..') { if (@na) { pop @na; # discard previous } else { $wmsg = "WARNING: Got relative .. without previous!!! [$path]"; prtw( "$wmsg\n" ); push(@warnings,$wmsg); } } elsif (length($p)) { # added 26/12/2007 push(@na,$p); } } foreach my $pt (@na) { $npath .= "\\" if length($npath); $npath .= $pt; } return $npath; } sub expand_it($) { my ($txt) = shift; my $len = length($txt); my ($j, $ch, $pch, $k, $nch, $tag); $pch = ''; my $ntxt = ''; for ($j = 0; $j < $len; $j++) { $ch = substr($txt,$j,1); $tag = ''; if ($ch eq '$') { # start of MACRO $k = $j + 1; if ($k < $len) { $nch = substr($txt,$k,1); if ($nch eq '(') { # start $( - find ) $k++; for (; $k < $len; $k++) { $pch = substr($txt,$k,1); if ($pch eq ')') { # found CLOSE last; } elsif ($pch eq ':') { last; } $tag .= $pch; } } } } if (length($tag)) { if (defined $makemacs{$tag}) { $ntxt .= $makemacs{$tag}; $j = $k; } else { $ntxt .= $ch; } } else { $ntxt .= $ch; } } return $ntxt; } # try to deal with ALL $(ABC) items sub expand_it_better($$) { my ($lnn,$txt) = @_; my $len = length($txt); prt("[dbg13] $lnn: Expanding line [$txt]($len)\n") if ($dbg13); my ($j, $ch, $pch, $k, $nch, $tag, $tmp); $pch = ''; my $ntxt = ''; for ($j = 0; $j < $len; $j++) { $ch = substr($txt,$j,1); $tag = ''; if ($ch eq '$') { # start of MACRO $k = $j + 1; # bump to NEXT char if ($k < $len) { # if there is more $nch = substr($txt,$k,1); # get next if ($nch eq '(') { # start $( - find ) $k++; # bump again for (; $k < $len; $k++) { $pch = substr($txt,$k,1); if ($pch eq ')') { # found CLOSE last; #} elsif ($pch eq ':') { } elsif ( !($pch =~ /(\w|-)/) ) { $tag = ''; last; } $tag .= $pch; # build up a tag } } } } if (length($tag)) { if (defined $makemacs{$tag}) { $tmp = $makemacs{$tag}; prt("[dbg13] Substitution: [$tag], with [$tmp]\n") if ($dbg13); $ntxt .= $tmp; # extract $j = $k; # bump to here } else { prt("[dbg12] Note [$tag] not in MACS at present!\n") if ($dbg12); $ntxt .= $ch; } } else { $ntxt .= $ch; } } if ($txt eq $ntxt) { prt("[dbg13] $lnn: Done expansion - NO CHANGE\n") if ($dbg13); } else { prt("[dbg13] $lnn: Done expansion - [$ntxt]\n") if ($dbg13); } return $ntxt; } # care only accept ^\s*(\w+)\s*: sub get_target_subject($) { my ($line) = shift; my $subj = ''; if ($line =~ /^\s*([\w-]+)\s*:/) { $subj = $1; } prt("[dbg10] Returning subject [$subj]\n") if ($dbg10); return $subj; } sub get_target_subject_OLD($) { my ($line) = shift; my $len = length($line); my $subj = ''; my ($i,$ch); for ($i = 0; $i < $len; $i++) { $ch = substr($line,$i,1); last if ($ch =~ /\S/); } # get subject, until ':' for (; $i < $len; $i++) { $ch = substr($line,$i,1); next if ($ch =~ /\s/); last if ($ch eq ':'); $subj .= $ch; } prt("[dbg10] Returning subject [$subj]\n") if ($dbg10); return $subj; } sub is_target_line($$) { my ($line,$rsub) = @_; my ($tmp); if ( ($line =~ /:/) && !($line =~ /:=/) ) { $tmp = get_target_subject($line); if (length($tmp)) { ${$rsub} = $tmp; return 1; } } return 0; } sub is_iffy_line($$) { my ($line,$lnn) = @_; my $ret = 0; if ($line =~ /^ifdef\s+/) { push(@if_stack,$lnn); $ret = 1; } elsif ($line =~ /^ifndef\s+/) { push(@if_stack,$lnn); $ret = 2; } elsif ($line =~ /^\@if\s+/) { push(@if_stack,$lnn); $ret = 2; } elsif ($line =~ /^else/) { $ret = 3; } elsif ($line =~ /^endif/) { if (@if_stack) { pop @if_stack; $ret = 4; } else { $ret = 5; # appears an ENDIF, NOT STACKED # maybe belongs to ifequ or ifnequ } } return $ret; } sub prtdw($) { my ($txt) = shift; if ($show_not_defined) { prt($txt); } } sub deal_with_iffy($$$) { my ($line,$lnn,$typ) = @_; my ($def,$cnt,$val); my $msg = ''; my $min = 80; $cnt = scalar @def_stack; if ($line =~ /^ifdef\s+(\w+)(.*)$/) { $def = $1; push(@def_stack,[$def,'YES']); $cnt = scalar @def_stack; $msg = "[dbg06] ifdef:$lnn:$typ: Added [$def] to def_stack"; if (defined $defines{$def}) { $act_define = 'YES_'.$def; } elsif (defined $makemacs{$def}) { $act_define = 'YES_'.$def; } else { if (defined $defines_seen{$def}) { # do NOT repeat a message } else { prtdw("WARNING:$lnn: ifdef [$def] NOT in defines. Assume NOT defined!\n"); $defines_seen{$def} = 1; } $act_define = 'NOO_'.$def; $def_stack[-1][1] = "NO"; } } elsif ($line =~ /^\@if\s+(\w+)(.*)$/) { $def = $1; push(@def_stack,[$def,'YES']); $cnt = scalar @def_stack; $msg = "[dbg06] ifdef:$lnn:$typ: Added [$def] to def_stack"; if (defined $defines{$def}) { $act_define = 'YES_'.$def; } elsif (defined $makemacs{$def}) { $act_define = 'YES_'.$def; } else { if (defined $defines_seen{$def}) { # do NOT repeat a message } else { prtdw("WARNING:$lnn: ifdef [$def] NOT in defines. Assume NOT defined!\n"); $defines_seen{$def} = 1; } $act_define = 'NOO_'.$def; $def_stack[-1][1] = "NO"; } } elsif ($line =~ /^ifndef\s(\w+)(.*)$/) { $def = $1; push(@def_stack,[$def,'NO']); $cnt = scalar @def_stack; $msg = "[dbg06] ifndef:$lnn:$typ: Added [$def] to def_stack"; if (defined $defines{$def}) { $act_define = 'NO__'.$def; } elsif (defined $makemacs{$def}) { $act_define = 'NO__'.$def; } else { if (defined $defines_seen{$def}) { # do NOT repeat a message } else { prtdw("WARNING:$lnn: ifndef [$def] NOT in defines. Assumed not defined!\n"); $defines_seen{$def} = 1; } $act_define = 'NOT_'.$def; $def_stack[-1][1] = "YES"; } } elsif ($line =~ /^else\s*(.*)$/) { # switch last to opposite $cnt = scalar @def_stack; $def = "*NO STACK*"; $val = "*NO SWITCH*"; if (@def_stack) { $def = $def_stack[-1][0]; $val = $def_stack[-1][1]; if ($val eq 'YES') { $def_stack[-1][1] = "NO"; } else { $def_stack[-1][1] = "YES"; } } else { prtw("WARNING:$lnn: No stacked defines on 'else'\n"); } $msg = "[dbg06] else:$lnn:$typ: [$def] switched [$val]"; } elsif ($line =~ /^endif\s*(.*)$/) { # out of IF $cnt = scalar @def_stack; $def = "*NO STACK*"; $val = "*NO END*"; if ($typ != 5) { $act_define = ''; if (@def_stack) { $def = $def_stack[-1][0]; $val = $def_stack[-1][1]; pop @def_stack; $cnt = scalar @def_stack; } else { prtw("WARNING:$lnn: No stacked defines on 'endif'\n"); } } $msg = "[dbg06] endif:$lnn:$typ: [$def] closed [$val]"; } elsif ($line =~ /\@*if\s+\%/) { # just ignore this, like # [@if %ERRORLEVEL% NEQ 0 @( \] } else { prtw("WARNING:$lnn: Unhandled IFFY line [$line]\n"); $msg = "[dbg06] WARNING: Unhandled IFFY line"; } if ($dbg06) { $msg .= ' ' while (length($msg) < $min); prt("$msg $cnt\n"); prt("\n") if ($cnt == 0); } } sub get_sources($) { my ($inf) = shift; if (!open INF, "<$inf") { prtw( "WARNING: Unable to open [$inf]...\n" ); return; } my @lines = ; close INF; my ($inf_nam,$inf_dir) = fileparse($inf); my ($lc, $line, $i, $nxln, $ifeq, $equ, $ecnt, $con, $j, $iftyp); my ($lnnum, $bgnln, $endln, $inc); my ($pt1, $pt2, $disc, $pt2exp); my ($def,$msg,$msg2,$subj,$isif,$ff); $lc = scalar @lines; prt( "Get $lc lines, from [$inf]...\n" ); my @cond = (); my @ifequ = (); for ($i = 0; $i < $lc; $i++) { $lnnum = $i + 1; $bgnln = $lnnum; # begin, and $endln = $lnnum; # end $line = trim_all($lines[$i]); next if (length($line) == 0); next if ($line =~ /^#/); if ( $line =~ /\\$/ ) { prt("[dbg14] $bgnln: GOT continuation character - an ending '\'...\n") if ($dbg14); # join this line with the next, until NO continuation $i++; $lnnum = $i + 1; $line =~ s/\\$/ /; # convert continuation to SPACE for ( ; $i < $lc; $i++) { # and process next line $lnnum = $i + 1; $nxln = trim_all($lines[$i]); next if ($nxln =~ /^#/); # skip comment lines if (length($nxln)) { if ($nxln =~ /\\$/) { $nxln =~ s/\\$/ /; $line .= $nxln; } else { $line .= $nxln; last; } } else { last; # empty line breaks pattern } } $endln = $lnnum; prt("[dbg14] $bgnln:$endln: END continuation character...\n") if ($dbg14); } # process the acquired FULL line prt("[dbg09] $bgnln:$endln: line [$line]\n") if ($dbg09); $pt2exp = expand_it_better($bgnln,$line); if ($line ne $pt2exp) { prt("[dbg09] $bgnln:$endln: expanded [$pt2exp]\n") if ($dbg09); $line = $pt2exp; } if (is_target_line($line,\$subj)) { prt("$bgnln: Is target [$subj], eat ALL lines until either blank, or another target line...\n"); # should also include/exclude per 'ifdef/ifndef...else...endif $i++; $lnnum = $i + 1; $line .= "{ "; # open braces for ( ; $i < $lc; $i++) { # and process next line $lnnum = $i + 1; $nxln = trim_all($lines[$i]); next if ($nxln =~ /^#/); # skip comment lines if (length($nxln)) { $isif = is_iffy_line($nxln,$lnnum); if ($isif) { deal_with_iffy($nxln,$lnnum,$isif); next; } if (is_target_line($nxln,\$msg)) { $i--; # backup to catch this line $line .= " } "; last; } $line .= ' ' if ( !($line =~ /\s$/) ); $line .= $nxln; } else { $line .= " } "; last; # empty line break pattern } } if (defined $targets{$subj}) { prtw("$bgnln:$endln: WARNING: Subject [$subj] REPEATED!\n"); } $targets{$subj} = $line; $endln = $lnnum; prt("$bgnln:$endln: End target lines for subject [$subj]\n"); prt("[dbg09] $bgnln:$endln: SUBJECT : [$line]\n") if ($dbg09); next; } if (( $line =~ /^ifeq\s+(.+)$/ )|| ( $line =~ /^ifneq\s+(.+)$/ )) { $ifeq = $1; # eat all the LINES inside this ifeq or ifneq $iftyp = substr($line,0,3); if ($ifeq =~ /,/) { @ifequ = split(',',$ifeq); $ecnt = scalar @ifequ; for ($j = 0; $j < $ecnt; $j++) { $equ = trim_all($ifequ[$j]); if ($equ =~ /^\(\$\((\w+)\)$/) { $con = $1; if (defined $makemacs{$con}) { prt( "[dbg01] $con = $makemacs{$con}\n" ) if ($dbg01); } else { prt( "NO MATCH FOR $con\n" ); } } } } push(@cond,$ifeq); # stack a condition $bgnln = $lnnum; $i++; $lnnum = $i + 1; for ( ; $i < $lc; $i++) { # YUK, can have ifdef, ifndef, else, endif INSIDE this # ---------------------------------------------------- $lnnum = $i + 1; $nxln = $lines[$i]; chomp $nxln; if (length($nxln)) { $nxln = trim_all($nxln); next if ($nxln =~ /^#/); if (( $nxln =~ /ifeq\s+(.+)$/ )|| ( $nxln =~ /ifneq\s+(.+)$/ )) { $ifeq = $1; push(@cond, $ifeq); } $line .= ' ' . $nxln; $isif = is_iffy_line($nxln,$lnnum); if ($isif && @def_stack) { deal_with_iffy($nxln,$lnnum,$isif); } #if ($nxln =~ /endif/) { if ($isif == 5) { if (@cond) { pop @cond; } if (! @cond) { last; } } } } $endln = $lnnum; $msg2 = (length($line) > $max_line) ? substr($line,0,$max_line).'...' : $line; prt( "[dbg01|07] $bgnln:$endln: IF [$ifeq] {$msg2}\n" ) if ($dbg01 || $dbg07); next; } # handle ifdef, ifndef, else, endif $isif = is_iffy_line($line,$lnnum); if ($isif) { deal_with_iffy($line,$lnnum,$isif); next; } # handle 'define' if ($line =~ /^define\s+(.+)$/) { $def = $1; $i++; $lnnum = $i + 1; $line = "{"; # open braces for ( ; $i < $lc; $i++) { # and process next line $lnnum = $i + 1; $nxln = trim_all($lines[$i]); next if ($nxln =~ /^#/); # skip comment lines if (length($nxln)) { last if ($nxln =~ /^endif\s*/); $line .= ' '; $line .= $nxln; } } $line .= "}"; $makemacs{$def} = $line; next; } # handle 'export' something if ($line =~ /^export\s+(.*)$/) { next; } elsif ($line =~ /^unexport\s+(.*)$/) { next; } #if ($line =~ /=/) { #if ($line =~ /^[\w-]+\s*\+*=/) { if ($line =~ /^[\w-]+\s*(\+|:|\?)*=/) { my @parts = split('=',$line); my $pc = scalar @parts; if ($pc < 2) { # prt("WARNING: Only got $pc part for line [$line]!\n"); $pt1 = trim_all($parts[0]); if (defined $makemacs{$pt1}) { prt("[dbg01] $bgnln:$lnnum: [$pt1]=[] already exists in makemacs\n") if ($dbg01); } else { prt("[dbg01] $bgnln:$lnnum: [$pt1]=[] to makemacs\n") if ($dbg01); $makemacs{$pt1} = ""; } next; } if ($pc > 2) { for (my $j = 2; $j < $pc; $j++) { $parts[1] .= '='.$parts[$j]; } } $pt1 = trim_all($parts[0]); if ($pt1 =~ /\+$/) { $pt1 =~ s/\+$//; $pt1 = trim_all($pt1); } $pt2 = trim_all($parts[1]); $disc = ''; if ($pt1 =~ /^(\w+)\s*:/) { $disc = substr($pt1,length($1)); $pt1 = $1; } $pt2exp = expand_it($pt2); if ($pt2 ne $pt2exp) { prt("[dbg01] un-expanded: [$pt1]=[$pt2]\n") if ($dbg01); } #if (defined $makemacs{$pt1}) { # prt("[dbg01] $bgnln:$lnnum: [$pt1]=[$pt2exp] added makemacs ($disc)\n") if ($dbg01); # $makemacs{$pt1} .= " && " . $pt2exp; #} else { prt("[dbg01] $bgnln:$lnnum: [$pt1]=[$pt2exp] to makemacs ($disc)\n") if ($dbg01); $makemacs{$pt1} = $pt2exp; #} } elsif ($line =~ /^-*include\s+(.*)/) { $inc = trim_all($1); $pt2exp = expand_it($inc); if ($inc ne $pt2exp) { prt("[dbg01] un-expanded: [$inc]\n") if ($dbg01); } prt( "[dbg01] $bgnln:$lnnum: include {$pt2exp}\n" ) if ($dbg01); } else { $pt2exp = expand_it($line); $msg = (length($pt2exp) > $max_line) ? substr($pt2exp,0,$max_line).'...' : $pt2exp; if ($line ne $pt2exp) { $msg2 = (length($line) > $max_line) ? substr($line,0,$max_line).'...' : $line; prt("[dbg01|05] un-expanded: [$msg2]\n") if ($dbg01 || $dbg05); $line = $pt2exp; } prt( "[dbg01|04] $bgnln:$lnnum: [$msg]\n" ) if ($dbg01 || $dbg04); } if ($line =~ /^\!include\s+(.+)$/) { $inc = $1; $ff = $inf_dir.$inc; get_sources($ff); } prt( "[dbg11] $bgnln:$lnnum: Done [$line]\n" ) if ($dbg11); } } sub get_sources_PREVIOUS($) { my ($inf) = shift; if (!open INF, "<$inf") { prtw( "WARNING: Unable to open [$inf]...\n" ); return; } my @lines = ; close INF; my ($inf_nam,$inf_dir) = fileparse($inf); my ($lc, $line, $i, $nxln, $ifeq, $equ, $ecnt, $con, $j, $iftyp); my ($lnnum, $bgnln, $endln, $inc); my ($pt1, $pt2, $disc, $pt2exp); my ($def,$msg,$msg2,$subj,$isif,$ff); $lc = scalar @lines; prt( "Get $lc lines, from [$inf]...\n" ); my @cond = (); my @ifequ = (); for ($i = 0; $i < $lc; $i++) { $lnnum = $i + 1; $bgnln = $lnnum; $endln = $lnnum; $line = trim_all($lines[$i]); next if (length($line) == 0); next if ($line =~ /^#/); if ( $line =~ /\\$/ ) { # GOT continuation character - an ending '\' # join this line with the next, until NO continuation $i++; $lnnum = $i + 1; $line =~ s/\\$/ /; # convert continuation to SPACE for ( ; $i < $lc; $i++) { # and process next line $lnnum = $i + 1; $nxln = trim_all($lines[$i]); next if ($nxln =~ /^#/); # skip comment lines if (length($nxln)) { if ($nxln =~ /\\$/) { $nxln =~ s/\\$/ /; $line .= $nxln; } else { $line .= $nxln; last; } } else { last; # empty line breaks pattern } } $endln = $lnnum; } # process the acquired FULL line prt("[dbg09] $bgnln:$endln: line [$line]\n") if ($dbg09); $pt2exp = expand_it_better($bgnln,$line); if ($line ne $pt2exp) { prt("[dbg09] $bgnln:$endln: expanded [$pt2exp]\n") if ($dbg09); $line = $pt2exp; } if (is_target_line($line,\$subj)) { # eat ALL lines until either blank, or another target line # should also include/exclude per 'ifdef/ifndef...else...endif $i++; $lnnum = $i + 1; $line .= "{ "; # open braces for ( ; $i < $lc; $i++) { # and process next line $lnnum = $i + 1; $nxln = trim_all($lines[$i]); next if ($nxln =~ /^#/); # skip comment lines if (length($nxln)) { $isif = is_iffy_line($nxln,$lnnum); if ($isif) { deal_with_iffy($nxln,$lnnum,$isif); next; } if (is_target_line($nxln,\$msg)) { $i--; # backup to catch this line $line .= " } "; last; } $line .= ' ' if ( !($line =~ /\s$/) ); $line .= $nxln; } else { $line .= " } "; last; # empty line break pattern } } if (defined $targets{$subj}) { prtw("$bgnln:$endln: WARNING: Subject [$subj] REPEATED!\n"); } $targets{$subj} = $line; $endln = $lnnum; prt("[dbg09] $bgnln:$endln: SUBJECT : [$line]\n") if ($dbg09); next; } if (( $line =~ /^ifeq\s+(.+)$/ )|| ( $line =~ /^ifneq\s+(.+)$/ )) { $ifeq = $1; # eat all the LINES inside this ifeq or ifneq $iftyp = substr($line,0,3); if ($ifeq =~ /,/) { @ifequ = split(',',$ifeq); $ecnt = scalar @ifequ; for ($j = 0; $j < $ecnt; $j++) { $equ = trim_all($ifequ[$j]); if ($equ =~ /^\(\$\((\w+)\)$/) { $con = $1; if (defined $makemacs{$con}) { prt( "[dbg01] $con = $makemacs{$con}\n" ) if ($dbg01); } else { prt( "NO MATCH FOR $con\n" ); } } } } push(@cond,$ifeq); # stack a condition $bgnln = $lnnum; $i++; $lnnum = $i + 1; for ( ; $i < $lc; $i++) { # YUK, can have ifdef, ifndef, else, endif INSIDE this # ---------------------------------------------------- $lnnum = $i + 1; $nxln = $lines[$i]; chomp $nxln; if (length($nxln)) { $nxln = trim_all($nxln); next if ($nxln =~ /^#/); if (( $nxln =~ /ifeq\s+(.+)$/ )|| ( $nxln =~ /ifneq\s+(.+)$/ )) { $ifeq = $1; push(@cond, $ifeq); } $line .= ' ' . $nxln; $isif = is_iffy_line($nxln,$lnnum); if ($isif && @def_stack) { deal_with_iffy($nxln,$lnnum,$isif); } #if ($nxln =~ /endif/) { if ($isif == 5) { if (@cond) { pop @cond; } if (! @cond) { last; } } } } $endln = $lnnum; $msg2 = (length($line) > $max_line) ? substr($line,0,$max_line).'...' : $line; prt( "[dbg01|07] $bgnln:$endln: IF [$ifeq] {$msg2}\n" ) if ($dbg01 || $dbg07); next; } # handle ifdef, ifndef, else, endif $isif = is_iffy_line($line,$lnnum); if ($isif) { deal_with_iffy($line,$lnnum,$isif); next; } # handle 'define' if ($line =~ /^define\s+(.+)$/) { $def = $1; $i++; $lnnum = $i + 1; $line = "{"; # open braces for ( ; $i < $lc; $i++) { # and process next line $lnnum = $i + 1; $nxln = trim_all($lines[$i]); next if ($nxln =~ /^#/); # skip comment lines if (length($nxln)) { last if ($nxln =~ /^endif\s*/); $line .= ' '; $line .= $nxln; } } $line .= "}"; $makemacs{$def} = $line; next; } # handle 'export' something if ($line =~ /^export\s+(.*)$/) { next; } elsif ($line =~ /^unexport\s+(.*)$/) { next; } #if ($line =~ /=/) { #if ($line =~ /^[\w-]+\s*\+*=/) { if ($line =~ /^[\w-]+\s*(\+|:|\?)*=/) { my @parts = split('=',$line); my $pc = scalar @parts; if ($pc < 2) { # prt("WARNING: Only got $pc part for line [$line]!\n"); $pt1 = trim_all($parts[0]); if (defined $makemacs{$pt1}) { prt("[dbg01] $bgnln:$lnnum: [$pt1]=[] already exists in makemacs\n") if ($dbg01); } else { prt("[dbg01] $bgnln:$lnnum: [$pt1]=[] to makemacs\n") if ($dbg01); $makemacs{$pt1} = ""; } next; } if ($pc > 2) { for (my $j = 2; $j < $pc; $j++) { $parts[1] .= '='.$parts[$j]; } } $pt1 = trim_all($parts[0]); if ($pt1 =~ /\+$/) { $pt1 =~ s/\+$//; $pt1 = trim_all($pt1); } $pt2 = trim_all($parts[1]); $disc = ''; if ($pt1 =~ /^(\w+)\s*:/) { $disc = substr($pt1,length($1)); $pt1 = $1; } $pt2exp = expand_it($pt2); if ($pt2 ne $pt2exp) { prt("[dbg01] un-expanded: [$pt1]=[$pt2]\n") if ($dbg01); } if (defined $makemacs{$pt1}) { prt("[dbg01] $bgnln:$lnnum: [$pt1]=[$pt2exp] added makemacs ($disc)\n") if ($dbg01); $makemacs{$pt1} .= " && " . $pt2exp; } else { prt("[dbg01] $bgnln:$lnnum: [$pt1]=[$pt2exp] to makemacs ($disc)\n") if ($dbg01); $makemacs{$pt1} = $pt2exp; } } elsif ($line =~ /^-*include\s+(.*)/) { $inc = trim_all($1); $pt2exp = expand_it($inc); if ($inc ne $pt2exp) { prt("[dbg01] un-expanded: [$inc]\n") if ($dbg01); } prt( "[dbg01] $bgnln:$lnnum: include {$pt2exp}\n" ) if ($dbg01); } else { $pt2exp = expand_it($line); $msg = (length($pt2exp) > $max_line) ? substr($pt2exp,0,$max_line).'...' : $pt2exp; if ($line ne $pt2exp) { $msg2 = (length($line) > $max_line) ? substr($line,0,$max_line).'...' : $line; prt("[dbg01|05] un-expanded: [$msg2]\n") if ($dbg01 || $dbg05); $line = $pt2exp; } prt( "[dbg01|04] $bgnln:$lnnum: [$msg]\n" ) if ($dbg01 || $dbg04); } if ($line =~ /^\!include\s+(.+)$/) { $inc = $1; $ff = $inf_dir.$inc; get_sources($ff); } prt( "[dbg11] $bgnln:$lnnum: Done [$line]\n" ) if ($dbg11); } } sub add_obj_item($) { my ($itm) = @_; $itm = unix_2_dos($itm); if (defined $obj_hash{$itm}) { $obj_hash{$itm}++; } else { $obj_hash{$itm} = 1; } } sub add_hdr_item($) { my ($itm) = @_; if (defined $hdr_hash{$itm}) { $hdr_hash{$itm}++; } else { $hdr_hash{$itm} = 1; } } sub has_hdr_ext($) { my ($hdr) = @_; return 1 if ($hdr =~ /\.h$/i); return 1 if ($hdr =~ /\.hxx$/i); return 1 if ($hdr =~ /\.hpp$/i); return 0; } sub split_into_objs($) { my ($val) = @_; my @arr = split(/\s/,$val); my $cnt = scalar @arr; my ($itm,$itm2,@a2); foreach $itm (@arr) { if ($itm =~ /\.o$/) { if ($itm =~ /,/) { @a2 = split(",",$itm); foreach $itm2 (@a2) { if ($itm2 =~ /\.o$/) { add_obj_item($itm2); } } } else { add_obj_item($itm); } } elsif (has_hdr_ext($itm)) { if ($itm =~ /,/) { @a2 = split(",",$itm); foreach $itm2 (@a2) { if ($itm2 =~ /\.o$/) { add_hdr_item($itm2); } } } else { add_hdr_item($itm); } } } } sub show_macros($) { my ($inf) = @_; my ($item,$val,$min,$len,$itexp,$msg,$max); $min = 0; $max = 80; foreach $item (keys %makemacs) { $val = $makemacs{$item}; $itexp = expand_it($item); $len = length($itexp); $min = $len if ($len > $min); last if ($min > 40); } $min = 40 if ($min > 40); foreach $item (keys %makemacs) { $val = $makemacs{$item}; $itexp = expand_it($item); $msg = ''; if ($item ne $itexp) { $msg = " Expanded [$item]"; } $itexp .= ' ' while (length($itexp) < $min); my @arr = split_into_objs($val); if (length($val) > $max) { $val = substr($val,0,$max)."..."; } prt("[$itexp] = [$val] $msg\n") if ($dbg02); } } sub list_ref_hash($$$) { my ($inf,$rh,$typ) = @_; my @objs = sort keys(%{$rh}); my $cnt = scalar @objs; prt("\nList of $cnt $typ...\n"); my ($msg,$obj,@arr,$path,$pc,$cp,$np,$i,$not); $msg = ''; $path = ''; $not = 0; foreach $obj (@objs) { if ($obj =~ /(\\|\/)/) { @arr = split(/(\\|\/)/,$obj); $pc = scalar @arr; $pc-- if ($pc); $cp = ''; for ($i = 0; $i < $pc; $i++) { $np = $arr[$i]; $cp .= '/' if (length($cp)); $cp .= $np; } if ($cp ne $path) { prt("$msg\n") if (length($msg)); $msg = $obj; $path = $cp; } else { $msg .= ' ' if (length($msg)); $msg .= $obj; if (length($msg) > 80) { prt("$msg\n"); $msg = ''; } } } else { $not++; } } prt("$msg\n") if (length($msg)); prt("\nList of $not root $typ...\n") if ($not); $msg = ''; foreach $obj (@objs) { if (!($obj =~ /(\\|\/)/)) { $msg .= ' ' if (length($msg)); $msg .= $obj; if (length($msg) > 80) { prt("$msg\n"); $msg = ''; } } } prt("$msg\n") if (length($msg)); } sub convert_obj_to_files($) { my ($inf) = shift; my ($file,$tf,$nf,$subs,$fnd); my %hash = (); $subs = 0; foreach $file (keys %obj_hash) { $tf = $file; $file =~ s/o$//; $nf = $file.'c'; $fnd = 0; if (defined $file_hash{$nf}) { $hash{$nf} = 1; $subs++; $fnd = 1; } else { $nf = $file.'cxx'; if (defined $file_hash{$nf}) { $hash{$nf} = 1; $subs++; $fnd = 1; } else { $nf = $file.'cpp'; if (defined $file_hash{$nf}) { $hash{$nf} = 1; $subs++; $fnd = 1; } else { $hash{$tf} = 1; } } } if ($fnd) { my $ff = $fil_dir; $ff .= "\\" if ( !($ff =~ /(\\|\/)$/) ); $ff .= $nf; if (-f $ff) { # maybe search for 'main', if desired... # hasmain.pl => require 'chkmain.pl' or die "Unable to load chkmain.pl ...\n"; # vc6srcs01.pl => require 'chkmain.pl' or die "Unable to load chkmain.pl ...\n"; if ($check4main) { if (chkmain2(0,$ff)) { prtw("WARNING: File [$nf] contains a 'main'...\n"); } } } else { prtw("WARNING: Unable to locate [$ff]!\n"); } } else { prtw("WARNING: No file matching [$tf] FOUND!\n"); } } if ($subs && length($targ_dir)) { # have been given a target MSVC directory # convert files to that target my $dir = $fil_dir; # root directory of INPUT file $dir .= "\\" if (!($dir =~ /(\\|\/)$/)); prt("With ROOT [$dir], convert to TARGET [$targ_dir]\n"); my %h = (); foreach $file (keys %hash) { # the file is relative to the ROOT $dir $tf = $dir.$file; # get full qualified path my ($sn,$sd) = fileparse($tf); $nf = get_rel_dos_path($sd,$targ_dir); my $nrf = $nf.$sn; prt("From [$tf] to [$targ_dir], got [$nf], or [$nrf]?\n") if ($dbg03); $h{$nrf} = 1; } %hash = %h; } elsif ($subs) { prtw("WARNING: No target directory, so left relative to [$fil_dir]...\n"); } else { prtw("WARNING: Got NO substituions for the REAL file!\n"); } %obj_hash = %hash if ($subs); } sub list_objects($) { my ($inf) = @_; list_ref_hash($inf,\%obj_hash,"objects"); } sub list_headers($) { my ($inf) = @_; list_ref_hash($inf,\%hdr_hash,"headers"); } sub os_is_win() { return (($^O eq 'MSWin32') ? 1 : 0); } #sub sub_root_dir($$) { # exclude the ROOT FOLDER, # if there is a $root_dir, # and this file BEGINS with that root! sub sub_root_dir($$) { my ($root,$fil) = @_; my $lr = length($root); my $lf = length($fil); if ($lr && ($lr < $lf)) { my $off = 0; my $dfil = unix_2_dos($fil); my $droot = unix_2_dos($root); while ( substr($dfil,$off,1) eq substr($droot,$off,1) ) { $off++; } $fil = substr($fil,$off); } return $fil; } sub get_dir_list($$); # $missed{$src1} = get_file_type($src1); sub get_file_type($) { my ($src) = @_; return 4 if (is_text_ext_file($src)); return 8 if (is_resource_file($src)); return 2 if (is_h_source_extended($src)); return 1 if (is_c_source_extended($src)); return 0; } sub get_dir_list($$) { my ($root,$dir) = @_; my @dirs = (); my ($ff,$file,@files,$rf); if (opendir(DIR,$dir)) { @files = readdir(DIR); closedir(DIR); $dir .= "\\" if (!($dir =~ /(\\|\/)$/)); foreach $file (@files) { next if (($file eq '.')||($file eq '..')); $ff = $dir.$file; if (-d $ff) { push(@dirs,$ff); } elsif (-f $ff) { $rf = sub_root_dir($root,$ff); $file_hash{$rf} = get_file_type($rf); } else { prtw("WARNING: What is THIS [$ff]?\n"); } } } foreach $file (@dirs) { get_dir_list($root,$file); } } sub get_root_dir_list($) { my ($dir) = shift; my @dirs = (); my ($ff,$file,@files); if (opendir(DIR,$dir)) { @files = readdir(DIR); closedir(DIR); $dir .= "\\" if (!($dir =~ /(\\|\/)$/)); foreach $file (@files) { next if (($file eq '.')||($file eq '..')); $ff = $dir.$file; if (-d $ff) { push(@dirs,$ff); } elsif (-f $ff) { $file_hash{$file} = get_file_type($file); } else { prtw("WARNING: What is THIS [$ff]?\n"); } } } foreach $file (@dirs) { get_dir_list($dir,$file); } } sub show_dir_list_debug() { my ($key,$val); my $cnt0 = 0; my $cnt1 = 0; my $cnt2 = 0; my $cnt4 = 0; my $cnt8 = 0; my $cntOther = 0; my %hash = (); foreach $key (keys %file_hash) { $val = $file_hash{$key}; if ($val == 8) { $cnt8++; } elsif ($val == 4) { $cnt4++; } elsif ($val == 2) { $cnt2++; } elsif ($val == 1) { $cnt1++; } elsif ($val == 0) { $cnt0++; } else { $cntOther++; } } prt("\n") if ($cnt1); %hash = (); foreach $key (keys %file_hash) { $val = $file_hash{$key}; if ($val == 1) { $hash{$key} = $val; #prt("$key\n"); } } list_ref_hash("",\%hash,"C/C++") if ($cnt1); prt("\n") if ($cnt2); %hash = (); foreach $key (keys %file_hash) { $val = $file_hash{$key}; if ($val == 2) { $hash{$key} = $val; #prt("$key\n"); } } list_ref_hash("",\%hash,"Headers") if ($cnt2); prt("\n") if ($cnt4); %hash = (); foreach $key (keys %file_hash) { $val = $file_hash{$key}; if ($val == 4) { $hash{$key} = $val; #prt("$key\n"); } } list_ref_hash("",\%hash,"Text") if ($cnt2); prt("\n") if ($cnt8); %hash = (); foreach $key (keys %file_hash) { $val = $file_hash{$key}; if ($val == 8) { $hash{$key} = $val; #prt("$key\n"); } } list_ref_hash("",\%hash,"resource") if ($cnt8); prt("\n") if ($cnt0); %hash = (); foreach $key (keys %file_hash) { $val = $file_hash{$key}; if ($val == 0) { $hash{$key} = $val; #prt("$key\n"); } } list_ref_hash("",\%hash,"other") if ($cnt0); prt("\nListing $cntOther other files...\n") if ($cntOther); %hash = (); foreach $key (keys %file_hash) { $val = $file_hash{$key}; if (!(($val == 0)||($val == 1)||($val == 2)||($val == 4)||($val == 8))) { $hash{$key} = $val; #prt("$key\n"); } } list_ref_hash("",\%hash,"OTHERS?") if ($cntOther); prt("\n"); } sub get_file_list($) { my ($inf) = shift; my ($nam,$dir) = fileparse($in_file); $dir = $cwd if ($dir =~ /^.(\\|\/)$/); $dir =~ s/(\\|\/)$//; local $| = 1; prt("Moment, get file list for [$dir]..."); get_root_dir_list($dir); my $cnt = scalar keys(%file_hash); prt( " done. Got $cnt file items...\n"); #show_dir_list_debug(); } # ======================================================= # writting DSP stuff sub get_def_dsp_hash_ref($) { my ($fil) = @_; my $rh = get_default_ref_hash($fil); #${$rh}{'PROJECT_VERS'} = 1; # version of the HASH #${$rh}{'PROJECT_FILE'} = $fil; #${$rh}{'PROJECT_FLAG'} = 0; #${$rh}{'PROJECT_APTP'} = ''; ${$rh}{'PROJECT_NAME'} = ''; #${$rh}{'PROJECT_CCNT'} = 0; # count of configurations #${$rh}{'PROJECT_CFGS'} = [ ]; #${$rh}{'PROJECT_SRCS'} = [ ]; #${$rh}{'CURR_FLAG'} = 0; #${$rh}{'CURR_LOFF'} = 0; # last/current source OFFSET #${$rh}{'CURR_LINE'} = ''; return $rh; } # [dbg_v40] STORE:1: In rcfgs (ra)[Release], [-NEW_OUTD-], [Release|Win32], & $dsp_sub_sub ] ) # [dbg_v40] STORE:2: In rcfgs (ra)[Debug], [-NEW_OUTD-], [Debug|Win32], & $dsp_sub_sub ] ) sub set_default_configs_2($) { my ($rh) = @_; my $var1 = "-NEW_OUTD-"; my $rcfgs = get_project_configs($rh); # 'PROJECT_CFGS' my ($dsp_sub_sub,$confname,$conf); $dsp_sub_sub = get_default_sub3(0); $confname = 'Release'; $conf = 'Release|WIN32'; push(@{$rcfgs}, [ $confname, $var1, $conf, $dsp_sub_sub ]); # ONLY STORE OF 'PROJECT_CFGS' ${$rh}{'PROJECT_CCNT'}++; # count of stored 'PROJECT_CFGS $dsp_sub_sub = get_default_sub3(1); $confname = 'Debug'; $conf = 'Debug|WIN32'; push(@{$rcfgs}, [ $confname, $var1, $conf, $dsp_sub_sub ]); # ONLY STORE OF 'PROJECT_CFGS' ${$rh}{'PROJECT_CCNT'}++; # count of stored 'PROJECT_CFGS } sub write_temp_dsp($$) { my ($inf,$dsp) = @_; my $dsp_ref_hash = get_def_dsp_hash_ref($dsp); # ============================================================= # 1: set PROJECT NAME ${$dsp_ref_hash}{'PROJECT_NAME'} = $proj_name; # ============================================================= # ============================================================== # 2: Set 'PROJECT_APTP' = Application TYPE string (from short forms) my $type = ''; if ( !get_app_type_4_short($proj_type,\$type) ) { prt("-type can ONLY be one of 'CA'=console (default), 'WA'=windows, 'DLL'=dynalib, or 'SL'=statlib!\n"); pgm_exit(1,"ERROR: Unable to get desired application type string from [$proj_type]!\n" ); } ${$dsp_ref_hash}{'PROJECT_APTP'} = $type; # ============================================================== # ============================================================== # 3: set C/C++ source files my ($src); my @sources = (); my $group = get_def_src_grp(); my $flist = get_def_src_filt(); # 0 1 2 3 4 # push(@{$src_ref}, [ $src, $group, $flist, 0, '' ]); # and PUSH onto SOURCE stack # push(@sources,[ $var, $group, $flist, 0, '' ]); foreach $src (keys %obj_hash) { push(@sources, [ $src, $group, $flist, 0, '' ]); } # could also set HEADER files $group = get_def_hdr_grp(); $flist = get_def_hdr_filt(); # ***TBD*** # store results ${$dsp_ref_hash}{'PROJECT_SRCS'} = [ @sources ]; # =============================================================== # =============================================================== # set CONFIGURATIONS #push(@{$rcfgs}, [ $confname, $var1, $conf, $dsp_sub_sub ]); # ONLY STORE OF 'PROJECT_CFGS' #${$rh}{'PROJECT_CCNT'}++; # count of stored 'PROJECT_CFGS # [dbg_v40] STORE:1: In rcfgs (ra)[Release], [-NEW_OUTD-], [Release|Win32], & $dsp_sub_sub ] ) # [dbg_v40] STORE:2: In rcfgs (ra)[Debug], [-NEW_OUTD-], [Debug|Win32], & $dsp_sub_sub ] ) set_default_configs_2($dsp_ref_hash); # ================================================================ if ( write_hash_to_DSP3( $dsp, $dsp_ref_hash, 0 ) ) { prt( "OK, written $dsp\n" ); my $dsw = get_simple_DSW_txt($proj_name,$proj_name.".dsp"); write2file($dsw,$temp_dsw); prt( "and written $temp_dsw\n" ); } else { prt( "FAILED on write $dsp!\n" ); } return $dsp_ref_hash; } sub is_src_type($) { my ($fil) = shift; return 1 if (is_c_source_extended($fil)); return 2 if (is_h_source_extended($fil)); return 0; } sub list_targets($) { my ($inf) = @_; my ($nam,$dir) = fileparse($inf); my @arr = keys %targets; my $tcnt = scalar @arr; prt("\nGot $tcnt TARGET keys...\n"); my ($key,$line,@srcs,$item,%dupes,$ff,$has_main,$max,$i); foreach $key (%targets) { $line = $targets{$key}; prt("$key: [$line]\n") if ($dbg08); if (defined $line and length($line)) { @arr = split(/\s/,$line); @srcs = (); %dupes = (); foreach $item (@arr) { if (is_src_type($item)) { if (!defined $dupes{$item}) { $ff = $dir.$item; $has_main = 3; if (-f $ff) { $has_main = 2; if ($check4main) { $has_main = 0; if (chkmain2(0,$ff)) { $has_main = 1; } } } push(@srcs,[$item,$has_main]); $dupes{$item} = 1; } } } $max = scalar @srcs; if ($max) { prt("Target [$key] has ".scalar @srcs." sources ["); for ($i = 0; $i < $max; $i++) { $item = $srcs[$i][0]; $has_main = $srcs[$i][1]; prt("$item($has_main) "); } prt("]\n"); } } } } ##################################################################### ### main ### parse_args(@ARGV); ($fil_name, $fil_dir) = fileparse($in_file); $fil_dir = $cwd."\\" if ($fil_dir =~ /^.(\\|\/)$/); $makemacs{'BLDDIR'} = $fil_dir; $makemacs{'SRCDIR'} = $fil_dir; prt( "Split in_file to [$fil_dir] [$fil_name]\n"); get_file_list( $in_file ); get_sources( $in_file ); list_targets( $in_file ); show_macros( $in_file ); convert_obj_to_files( $in_file ); list_headers( $in_file ); list_objects( $in_file ); write_temp_dsp( $in_file, $temp_dsp ); pgm_exit(0,""); ##################################################################### sub give_help { my ($tmp); prt("$pgmname: version 0.0.2 2010-08-23\n"); prt("Usage: $pgmname [options] makefile\n"); prt("Options:\n"); prt(" --help ( -h -?) = This help, and exit 0\n"); $tmp = get_dbg_range(); prt(" --dbg (-d) = Set DEBUG flag of this value. Number in range 1 to $tmp\n"); prt(" --in (-i) = Commands from an input file.\n"); prt(" --load-log (-l) = Load log at end.\n"); prt(" --mac itm val (-m) = Store a MACRO, item=value.\n"); prt(" --targ (-t) = Target directory for DSP file. If none given then that of the input file.\n"); prt("Purpose:\n"); prt(" Attempts to read the 'makefile' input file, and output\n"); prt(" a DSP file to [$temp_dsp]\n"); prt("Notes:\n"); prt(" The input file is a set of line delimited commands. Lines beginning with '#' are skipped.\n"); prt(" The debug switch is strictly for that. It add no functionality, just a noisier output,\n"); prt(" and has the text setting of 'all', 'none', or 'help', to show the list in more detail.\n"); $tmp = get_dbg_stg(); prt(" For debug, presently values [$tmp] are ON\n") if (length($tmp)); prt(" Warning: Paths, or more importantly, File name with spaces may NOT be handled correctly.\n"); prt(" Remember the command 'dir /X *' will display the 8.3 DOS format names to use instead.\n"); } sub show_dbg_help() { my $file = $0; my ($line,$max,$tmp); $max = get_dbg_range(); $tmp = get_dbg_stg(); prt(" --dbg (-d) = Set DEBUG flag of this value. Number in range 1 to $tmp\n"); prt(" Presently %tmp are ON.\n") if (length($tmp)); prt(" Additional text setting are 'all', 'none', and this 'help'.\n"); if (open INF, "<$file") { my @lines = ; close INF; prt(" Detailed list, with some 'notes' indicating what eash does.\n"); foreach $line (@lines) { $line = trim_all($line); if ($line =~ /^my\s+\$dbg(\d+)\s*=\s*\d+\s*;\s*(.+)$/) { $tmp = $1; prt("$tmp: $line\n"); } } } else { prt("ERROR: Unable to open file [$file], so NO DEBUG ADDITIONAL HELP!\n"); } } sub load_input_file($$) { my ($arg,$file) = @_; if (open INF, "<$file") { my @lines = ; close INF; my @carr = (); my ($line,@arr); foreach $line (@lines) { $line = trim_all($line); next if (length($line) == 0); next if ($line =~ /^#/); @arr = split(/\s/,$line); push(@carr,@arr); } parse_args(@carr); } else { pgm_exit(1,"ERROR: Unable to 'open' file [$file]!\n") } } sub need_arg { my ($arg,@av) = @_; pgm_exit(1,"ERROR: [$arg] must have follwoing argument!\n") if (!@av); } sub parse_args { my (@av) = @_; my ($arg,$sarg,$tmp); while (@av) { $arg = $av[0]; if ($arg =~ /-/) { $sarg = substr($arg,1); $sarg = substr($sarg,1) while ($sarg =~ /-/); if (($sarg =~ /^h/i)||($sarg eq '?')) { give_help(); pgm_exit(0,"Help exit(0)"); } elsif ($sarg =~ /^d/i) { need_arg(@av); shift @av; $sarg = $av[0]; $tmp = get_dbg_range(); if (($sarg =~ /^\d+$/)&&($sarg >= 1)&&($sarg <= $tmp)) { $tmp = 'dbg'; if ($sarg < 10) { $tmp .= "0$sarg"; } else { $tmp .= "$sarg"; } set_dbg_var($sarg); prt("Set Debug $tmp ON!\n"); } else { if ($sarg =~ /^\d+$/) { pgm_exit(1,"ERROR: Invalid argument [$arg $sarg]! Out of range 1 - $tmp\n"); } else { if ($sarg =~ /^help$/i) { show_dbg_help(); pgm_exit(0,"DEBUG Help exit(0)\n"); } elsif ($sarg =~ /^all$/i) { prt("Setting ALL debug ON!\n"); set_all_dbg_on(); } elsif ($sarg =~ /^none$/i) { prt("Setting ALL debug OFF!\n"); set_all_dbg_off(); } else { pgm_exit(1,"ERROR: Invalid argument [$arg $sarg]! Not numerical in range 1 - $tmp, or 'all' or 'none'!\n"); } } } } elsif ($sarg =~ /^i/i) { need_arg(@av); shift @av; $sarg = $av[0]; load_input_file($arg,$sarg); } elsif ($sarg =~ /^l/i) { $load_log = 1; prt("Set to load log at end.\n"); } elsif ($sarg =~ /^m/i) { # store a macro need_arg(@av); shift @av; $sarg = $av[0]; need_arg(@av); shift @av; $tmp = $av[0]; $makemacs{$sarg} = $tmp; prt("Set MACRO $sarg=$tmp\n"); } elsif ($sarg =~ /^t/i) { need_arg(@av); shift @av; $sarg = $av[0]; $targ_dir = File::Spec->rel2abs($sarg); prt("Set target directory to [$targ_dir]\n"); pgm_exit(1,"ERROR: Target DIRECTORY does NOT EXIST!\n") if (! -d $targ_dir); } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { $in_file = File::Spec->rel2abs($arg); prt("Set input to [$in_file]\n"); } shift @av; } if ((length($in_file) == 0)&& $debug_on) { $in_file = File::Spec->rel2abs($def_in_file); prt("[debug_on] Set input to DEFAULT [$in_file]\n"); #set_debug_on(); $load_log = 1; } if ($debug_on) { $sarg = 'XML_SRCDIR'; $tmp = "C:\\Projects\\libxm2"; $makemacs{$sarg} = $tmp; prt("Set DEBUG MACRO $sarg=$tmp\n"); } if (length($in_file) == 0) { pgm_exit(1,"ERROR: No input file found on command line!\n"); } elsif (! -f $in_file) { pgm_exit(1,"ERROR: Input file [$in_file] NOT FOUND!\n"); } if (length($root_dir) == 0) { ($arg,$root_dir) = fileparse($in_file); if ($root_dir =~ /^\.(\\|\/)$/) { $root_dir = $cwd; } prt("Set root directory to [$root_dir]\n"); } if (length($targ_dir) == 0) { $targ_dir = $root_dir; #$targ_dir .= "\\" if ( !($targ_dir =~ /(\\|\/)$/) ); #$targ_dir .= 'msvc'; prt("Set target directory to [$targ_dir]\n"); } } # eof - makesrcs02.pl