Generated: Sun Aug 21 11:11:13 2011 from makesrcs.pl 2010/08/23 39 KB.
#!/perl -w # NAME: makesrcs.pl # AIM: Read a makefile, and (hopefully) list the SOURCES # 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 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 = (); 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); # debug my $debug_on = 0; 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 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; } sub set_debug_on() { set_debug_val(1); } sub set_debug_off() { set_debug_val(0); } ##################################################################### ####### 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; } sub get_target_subject($) { 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("Returning subject [$subj]\n") if ($dbg10); return $subj; } sub is_target_line($$) { my ($line,$rsub) = @_; if ( ($line =~ /:/) && !($line =~ /:=/) ) { ${$rsub} = get_target_subject($line); 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]"; } else { prtw("WARNING: 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") { prt( "ERROR: Unable to open [$inf]...\n" ); return; } my @lines = <INF>; close 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); $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("$bgnln:$endln: line [$line]\n") if ($dbg09); 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("$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( "$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( "$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"); if (defined $makemacs{$pt1}) { prt("$bgnln:$lnnum: [$pt1]=[<blank>] already exists in makemacs\n") if ($dbg01); } else { prt("$bgnln:$lnnum: [$pt1]=[<blank>] 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("un-expanded: [$pt1]=[$pt2]\n") if ($dbg01); } if (defined $makemacs{$pt1}) { prt("$bgnln:$lnnum: [$pt1]=[$pt2exp] added makemacs ($disc)\n") if ($dbg01); $makemacs{$pt1} .= " && " . $pt2exp; } else { prt("$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("un-expanded: [$inc]\n") if ($dbg01); } prt( "$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("[dbg04] un-expanded: [$msg2]\n") if ($dbg01 || $dbg05); } prt( "[dbg04] $bgnln:$lnnum: [$msg]\n" ) if ($dbg01 || $dbg04); } } } 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'} = '<not started>'; 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 { 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"); prt(" -l = Load log at end.\n"); prt("Attempts to read the 'makefile' input file, and ouput\n"); prt("a DSP file to [$temp_dsp]\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); 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 =~ /^l/i) { $load_log = 1; prt("Set to load log at end.\n"); } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { $in_file = $arg; prt("Set input to [$in_file]\n"); } shift @av; } if ((length($in_file) == 0)&& $debug_on) { $in_file = $def_in_file; prt("[debug_on] Set input to DEFAULT [$in_file]\n"); #set_debug_on(); $load_log = 1; } 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 - makesrcs.pl