#!/perl -w # NAME: builddsp.pl # AIM: Accepts a directory for INPUT # and a directory for OUTPUT # and a project TYPE - window, console, static lib, or DLL # Scan the INPUT for *.c* and *.h* files, and BUILD a 'temp' DSP # to be placed in the OUTPUT folder, and use all the C/C++ files # as the sources # 16/03/2013 - change 'require' lib name form chkincinc.pl to lib_inkinc.pl # 2009/09/17 - added '# FILE LIST < 'Others', $C_TYPE => 'C/C++ ', $H_TYPE => 'Header', $D_TYPE => ' '); # debug my $test_cfg = 0; # test load config file, and exit my $dbg1 = 0; # show prt("push(\@arr, [$fil, $ff, $typ]);\n") my $dbg02 = 0; # output sources again my $dbg03 = 0; # show 'source' files in FULL - $styp = get_type_stg($typ); like C/C++: Headers: Others: my $write_dsp_dbg = 0; # 2 to show sources as processed, 8 to show subs... prt( "$0 ... Hello, scanning [$in_folder]...\n" ); sub is_c_source_ext($) { my ($fil) = shift; my ($nm, $dir, $ext) = fileparse( $fil, qr/\.[^.]*/ ); my $lce = lc($ext); if (($lce eq '.c') || ($lce eq '.cxx') || ($lce eq '.cpp') || ($lce eq '.cc')) { return 1; } return 0; } sub is_h_source_ext($) { my ($fil) = shift; my ($nm, $dir, $ext) = fileparse( $fil, qr/\.[^.]*/ ); my $lce = lc($ext); if (($lce eq '.h') || ($lce eq '.hxx') || ($lce eq '.hpp')) { return 1; } return 0; } sub mark_in_suggested($) { my ($fil) = @_; my $cnt = scalar @suggested_sources; my ($f,$j); if ($cnt) { for ($j = 0; $j < $cnt; $j++) { $f = $suggested_sources[$j][0]; if ($fil eq $f) { $suggested_sources[$j][1] = 1; return 1; } } prtw("WARNING: file [$fil] NOT found in suggested!\n"); return 0; } return 1; } # add_missing_suggested(\@cs, $rpath, $sgrp, $sflt); sub add_missing_C_suggested($$$$) { my ($rcs,$rpath,$sgrp,$sflt) = @_; my $cnt = scalar @suggested_sources; my ($f,$j, $add); $add = 0; if ($cnt) { for ($j = 0; $j < $cnt; $j++) { if ($suggested_sources[$j][1] == 0) { $f = $suggested_sources[$j][0]; my $sfile = $rpath.$f; if (is_c_source_ext($f)) { prt( "C/C++: S=$sfile - ADDED BY SUGGESTION\n" ); # 0 1 2 3 push(@{$rcs}, [$sfile, $sgrp, $sflt, 0] ); $suggested_sources[$j][1] = 1; } else { # prt( "C/C++: S=$sfile - HEADER NOT ADDED (BUT SUGGESTED)\n" ); } } } } return $add; } sub add_missing_H_suggested($$$$) { my ($rcs,$rpath,$sgrp,$sflt) = @_; my $cnt = scalar @suggested_sources; my ($f,$j, $add); $add = 0; if ($cnt) { for ($j = 0; $j < $cnt; $j++) { if ($suggested_sources[$j][1] == 0) { $f = $suggested_sources[$j][0]; my $sfile = $rpath.$f; if (is_h_source_ext($f)) { prt( "Header: S=$sfile - ADDED BY SUGGESTION\n" ); # 0 1 2 3 push(@{$rcs}, [$sfile, $sgrp, $sflt, 0] ); $suggested_sources[$j][1] = 1; } else { # prt( "C/C++: S=$sfile - HEADER NOT ADDED (BUT SUGGESTED)\n" ); } } } } return $add; } sub prtw($) { my ($txt) = shift; prt($txt); $txt =~ s/\n$//; push(@warnings,$txt); } sub show_warnings() { if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS ...\n" ); foreach my $line (@warnings) { prt("$line\n" ); } prt("\n"); } else { prt("\nNo warnings issued.\n\n"); } } sub get_type_stg($) { my ($typ) = shift; if (defined $type2stg{$typ}) { return $type2stg{$typ}; } return 'UNKNOWN($typ)'; } sub is_in_excluded($) { my ($fil) = shift; my $lcfil = lc($fil); foreach my $f (@exclude_files) { my $lcf = lc($f); if ($lcfil eq $lcf) { return 1 } } return 0; } sub file_has_main($) { my ($fil) = shift; #my $hm = chkmain($fil); my $hm = chkmain2(0,$fil); if ($hm) { prtw("WARNING: NOTE HAS MAIN: [$fil]\n"); return 1; } return 0; } sub file_has_includes($) { my ($fil) = shift; my $rincs = get_include_file_list($fil); my $icnt = scalar @{$rincs}; my $ccnt = 0; my $info = ''; foreach my $inc (@{$rincs}) { $inc =~ s/^\"//; $inc =~ s/\"$//; $inc =~ s/^$//; if (is_c_source_ext($inc)) { $info .= ' ' if length($info); $info .= $inc; $ccnt++; } } prtw( "WARNING: Found $ccnt C/C++ includes in [$fil] - [$info]\n" ) if length($info); return $info; } sub scan_directory($) { my ($ind) = shift; my ($DIR, $typ, $cnt, $hm); my ($ocnt, $ccnt, $hcnt, $dcnt, $fcnt); $ocnt = 0; $ccnt = 0; $hcnt = 0; $dcnt = 0; my @arr = (); if (opendir $DIR, $ind) { my @fils = readdir($DIR); closedir $DIR; $fcnt = scalar @fils; prt( "Got $fcnt files from [$ind]... scanning...\n" ); foreach my $fil (@fils) { next if (($fil eq '.')||($fil eq '..')); next if (is_in_excluded($fil)); my $ff = $ind; $ff .= "\\" if !($ff =~ /(\\|\/)$/ ); $ff .= $fil; $typ = $O_TYPE; $hm = 0; if (-d $ff) { $typ = $D_TYPE; $dcnt++; } else { my ($nm, $dir, $ext) = fileparse( $fil, qr/\.[^.]*/ ); my $lcext = lc($ext); $hm = file_has_main($ff); if (length($ext) == 0) { $ocnt++; ## let these through } elsif ( (($lcext eq '.h')||($lcext eq '.hxx')||($lcext eq '.hpp')) ) { $typ = $H_TYPE; $hcnt++; } elsif ( (($lcext eq '.c')||($lcext eq '.cxx')||($lcext eq '.cpp')) ) { $typ = $C_TYPE; file_has_includes($ff); $ccnt++; } else { $ocnt++; } } prt("push(\@arr, [$fil, $ff, $typ]);\n") if ($dbg1); # 0 1 2 3 push(@arr, [$fil, $ff, $typ, $hm]); $cnt++; } } else { prt("ERROR: Unable to open directory [$ind]!\n"); } prt("Return array with $cnt files "); prt( "Counts: o=$ocnt, c=$ccnt, h=$hcnt, d=$dcnt t=".($ocnt+$ccnt+$hcnt+$dcnt)."\n" ); return @arr; } sub get_project_hash($$) { my ($rfils,$rhash) = @_; my ($cnt, $i); $cnt = scalar @$rfils; prt("Test of $cnt files...\n"); my ($nm, $dir, $ext); my ($fil, $ff, $typ, $styp, $rpath, $sfile, $hm); my ($ocnt, $ccnt, $hcnt, $dcnt, $xcnt); my ($hm_msg); my @cs = (); my @hs = (); $ocnt = 0; $ccnt = 0; $hcnt = 0; $dcnt = 0; $xcnt = 0; for ($i = 0; $i < $cnt; $i++) { # push(@arr, [$fil, $ff, $typ, $hm]); $fil = $$rfils[$i][0]; $ff = $$rfils[$i][1]; $typ = $$rfils[$i][2]; $hm = $$rfils[$i][3]; $styp = get_type_stg($typ); # get type, like C/C++, Others, , etc ($nm, $dir, $ext) = fileparse( $ff, qr/\.[^.]*/ ); $rpath = get_rel_dos_path($dir,$out_folder); $sfile = "$rpath$fil"; $hm_msg = ($hm ? " HAS MAIN" : ""); if ($hm && $exclude_main) { prtw( "WARNING: EXCLUDED: $styp: S=$rpath$fil [$ff] HAS MAIN\n" ); $xcnt++; next; } if ($typ == $O_TYPE) { prt( "$styp: S=$rpath$fil " ); prt( "[$ff] " ) if ($dbg03); prt( "$hm_msg" ) if (length($hm_msg)); prt( "\n" ); $ocnt++; } elsif ($typ == $C_TYPE) { $ccnt++; } elsif ($typ == $H_TYPE) { $hcnt++; } elsif ($typ == $D_TYPE) { prt( "$styp: S=$rpath$fil [$ff] $hm_msg\n" ); $dcnt++; } else { prt("WARNING: "); prt( "$styp: S=$sfile [$ff] $hm_msg\n" ); } } if ($dbg03) { prt( "Counts: o=$ocnt, c=$ccnt, h=$hcnt, d=$dcnt total=".($ocnt+$ccnt+$hcnt+$dcnt) ); if ($xcnt) { prt( " Excluded=$xcnt"); } prt(" [dbg03]\n"); } my $sgrp = get_def_src_grp(); # "Source Files"; my $sflt = get_def_src_filt(); my $hgrp = get_def_hdr_grp(); # "Header Files"; my $hflt = get_def_hdr_filt(); my $srcrel = ''; my $hdrrel = ''; # Process C files - C/C++ # =============== for ($i = 0; $i < $cnt; $i++) { $fil = $$rfils[$i][0]; $ff = $$rfils[$i][1]; $typ = $$rfils[$i][2]; $hm = $$rfils[$i][3]; $styp = get_type_stg($typ); ($nm, $dir, $ext) = fileparse( $ff, qr/\.[^.]*/ ); $rpath = get_rel_dos_path($dir,$out_folder); $sfile = "$rpath$fil"; if ($typ == $C_TYPE) { $srcrel = $rpath if (length($srcrel) == 0); $hm = 2 if ( !mark_in_suggested($fil) && !$hm ); $hm_msg = (($hm == 1) ? " HAS MAIN" : ($hm == 2) ? " NOT IN SUGGESTED" : ""); #prt( "$styp: S=$sfile [$ff] $hm_msg\n" ); prt( "$styp: S=$rpath$fil " ); prt( "[$ff] " ) if ($dbg03); prt( "$hm_msg" ) if (length($hm_msg)); prt( "\n" ); # 0 1 2 3 push(@cs, [$sfile, $sgrp, $sflt, $hm] ); } } # Process H Files - Header # =============== for ($i = 0; $i < $cnt; $i++) { $fil = $$rfils[$i][0]; $ff = $$rfils[$i][1]; $typ = $$rfils[$i][2]; $hm = $$rfils[$i][3]; $styp = get_type_stg($typ); ($nm, $dir, $ext) = fileparse( $ff, qr/\.[^.]*/ ); $rpath = get_rel_dos_path($dir,$out_folder); $sfile = "$rpath$fil"; $hm_msg = ($hm ? " HAS MAIN" : ""); if ($typ == $H_TYPE) { $hdrrel = $rpath if (length($hdrrel) == 0); #prt( "$styp: S=$sfile [$ff] $hm_msg\n" ); prt( "$styp: S=$rpath$fil " ); prt( "[$ff] " ) if ($dbg03); prt( "$hm_msg" ) if (length($hm_msg)); prt( "\n" ); push(@hs, [$sfile, $hgrp, $hflt, $hm] ); mark_in_suggested($fil); } } # 20090916 - add any MISSING suggested C files add_missing_C_suggested(\@cs, $srcrel, $sgrp, $sflt); add_missing_H_suggested(\@hs, $hdrrel, $hgrp, $hflt); # Done @cs, and @hs lists - C/C++ and Headers # ----------------------- prt( "Counts: o=$ocnt, c=$ccnt, h=$hcnt, d=$dcnt total=".($ocnt+$ccnt+$hcnt+$dcnt)."\n" ); # build the HASH for the project #my %hash = get_default_sub(); #my $rhash = get_default_sub2(); my $at = 'APP_TYPE'; my $pn = "-NEW_PROJECT_NAME-"; my $sc = 'C_SOURCES'; my $sh = 'H_SOURCES'; if (!$got_proj_name) { $ff = $$rfils[0][1]; ($nm, $dir, $ext) = fileparse( $ff, qr/\.[^.]*/ ); my $dpath = path_u2d($dir); $dpath =~ s/\\$//; #my ($pname, $pdir, $pext) = fileparse($dir, qr/\.[^.]*/); my ($pname, $pdir, $pext) = fileparse($dpath); if (length($pname)) { prt( "Setting project name to [$pname]\n" ); $project_name = $pname; $got_proj_name = 2; } else { prt( "WARNING: Failed setting project name!\n" ); } } # set the project hash ${$rhash}{$at} = $project_type; ${$rhash}{$pn} = $project_name; ${$rhash}{$sc} = [@cs]; # insert C_SOURCES into project ${$rhash}{$sh} = [@hs]; # insert H_SOURCES into project if ($dbg02) { my $tmp = ${$rhash}{$sc}; my $tcnt = scalar @{$tmp}; for (my $ti = 0; $ti < $tcnt; $ti++) { my $tf = $$tmp[$ti][0]; $hm = $$tmp[$ti][3]; $hm_msg = ($hm ? " HAS MAIN" : ""); prt( "SOURCE:\"$tf\" $hm_msg\n" ); } } return $rhash; } sub get_trim_equ($) { my ($txt) = shift; my @a = split('#',$txt); my $ttx = $a[0]; $ttx = substr($ttx,0,length($ttx)-1) while ($ttx =~ /\s$/); #if ($ttx =~ /^['"]{1}(.+)["']{1}$/) if ($ttx =~ /^'{1}(.+)'{1}$/) { $ttx = $1; } return $ttx; } sub get_a_trimed_line($) { my ($txt) = shift; my $ttx = ''; my ($ll,$c,$i,$inq, $qt); $ll = length($txt); $inq = 0; $qt = ''; for ($i = 0; $i < $ll; $i++) { $c = substr($txt,$i,1); # char par char if ($inq) { if ($c eq $qt) { $inq = 0; next; } } else { if ($c eq '#') { return $ttx; } if (($c eq '"')||($c eq "'")) { $inq = 1; $qt = $c; next; } } if ($c =~ /\s/) { if ($inq) { $ttx .= $c; } } else { $ttx .= $c; } } return $ttx; } # 20090910 - substitution can be in any part of definition # and use the base_path to make a porject name, if none in config # 20090916 - added a # FILE LIST <; close INF; $cnt = scalar @lns; prt( "Processing $cnt lines, from config file [$fil]...\n" ); for ($k = 0; $k < $cnt; $k++) { $ln = $lns[$k]; chomp $ln; next if (length($ln) == 0); if ($ln =~ /^\s*#/) { if ($ln =~ /^\s*#\s+FILE\s+LIST\s+<<(\w+)$/) { $end = $1; prt( "Got start file list, ending at $end..\n" ); $k++; @arr = (); for (; $k < $cnt; $k++) { $ln = $lns[$k]; chomp $ln; $ln = trim_all($ln); next if (length($ln) == 0); $ln =~ s/\s+\\$//; if ($ln =~ /#\s+$end/) { prt( "End file list, ending at $end..\n" ); last; } $ln =~ s/^#\s*//; @atmp = split(/\s/,$ln); push(@arr,@atmp); } if ($k == $cnt) { prt("ERROR: Error in CONFIG FILE [$fil]! No '# $end' FOUND! FIX FIRST!!!\n"); exit(1); } prt( "Got ".scalar @arr." source files...\n" ); foreach $tmp (@arr) { if ( is_c_source_ext($tmp) || is_h_source_ext($tmp) ) { push(@suggested_sources, [$tmp, 0]); } else { prt( "WHAT IS THIS! [$tmp]\n" ); exit(1); } } } next; } if ($ln =~ /([-\w]+)\s*=\s*(.+)$/) { $par = $1; $equ = get_trim_equ($2); prt( "[dbg01] [$par] = [$equ]\n" ) if ($dbg01); if (defined $h{$par}) { $h{$par} .= " $equ"; } else { $h{$par} .= "$equ"; } } else { prt("ERROR IN CONFIG! What is this [$ln]\n"); prt("Fix file [$fil] to continue...\n" ); exit(1); } } # 20090910 - Do we HAVE a project NAME? if (! defined $h{$pn}) { # ok, none given in CONFIG if ( ! $got_proj_name ) { my $dpath = path_u2d($inf); $dpath =~ s/\\$//; my ($pname, $pdir) = fileparse($dpath); if (length($pname)) { prt( "NOTE WELL: Setting project name to [$pname]\n" ); $project_name = $pname; $got_proj_name = 3; $h{$pn} = $project_name; } else { prtw( "WARNING: Failed setting project name!\n" ); } } else { prt( "NOTE WELL: Setting project name to [$project_name]\n" ); $h{$pn} = $project_name; } } $cnt = scalar keys(%h); if ($cnt) { prt( "[dbg01] Processing $cnt config items...\n" ) if ($dbg01); # =========================================================== $tscnt = 0; $scnt = 0; foreach $k (keys %h) { $v = $h{$k}; if (defined ${$rdh}{$k}) { # add it here if ($v =~ /^\@(.+)\@$/) { # skip these in first run prt("[dbg01] Skipping $k = $v\n") if ($dbg01); } elsif ($v =~ /\@(.+)\@/) { $tmp = $1; prt( "[dbg01] Need substitution for [$tmp]!\n" ) if ($dbg01); if (defined $h{$tmp}) { $tmp2 = $h{$tmp}; $tmp3 = $v; $tmp3 =~ s/\@//g; $tmp3 =~ s/$tmp/$tmp2/; prt( "[dbg01] Got value [$tmp2]! Change [$v] to [$tmp3]! Is this OK?\n" ) if ($dbg01); $v = $tmp3; $h{$k} = $v; $scnt++; } else { prt( "ERROR: Key [$tmp] does NOT EXIST!\n" ); exit(1); } } ${$rdh}{$k} = $v; } else { prtw( "ERROR: config key [$k] NOT VALID!\n" ); exit(1); } } prt("Done $scnt substitutions in the first run...\n") if ($scnt && $dbg01); $tscnt += $scnt; $scnt = 0; foreach $k (keys %h) { $v = $h{$k}; if (defined ${$rdh}{$k}) { # add it here if ($v =~ /^\@(.+)\@$/) { $v = $1; if (defined $h{$v}) { prt( "Substituting [$v] with [".$h{$v}."]\n" ) if ($dbg01); $v = $h{$v}; $scnt++; } else { prt("ERROR IN CONFIG! What is this [$k]\n"); prt("Fix file [$fil] to continue...\n" ); exit(1); } } ${$rdh}{$k} = $v; } else { prtw( "ERROR: config key [$k] NOT VALID!\n" ); exit(1); } } $tscnt += $scnt; prt("Done $scnt substitutions in the 2nd run... Total $tscnt\n") if (($scnt || $tscnt) && $dbg01); # =========================================================== prt( "Done $cnt config items...\n" ); } else { prtw("WARNING: Found NO parameters in config file [$fil]!\n"); } } else { prtw("WARNING: Unable to open file $fil!\n"); } exit(1) if ($test_cfg); } sub get_config_hash($) { my ($fil) = shift; my $rdh = get_default_sub2(); # get a default hash (ref) if (length($fil)) { if (-f $fil) { load_config_file($fil, $rdh, $in_folder); } else { prtw("WARNING: Unable to find CONFIG file [$cfg_file]!\n"); } } return $rdh; } get_config_hash($cfg_file) if ($test_cfg); my @files = scan_directory($in_folder); if (@files) { #write_dsp_file("tempdsp.dsp",\@files); my $rch = get_config_hash($cfg_file); #my %h = get_project_hash(\@files); #write_hash_to_DSP( $out_dsp, \%h, 0 ); my $rh = get_project_hash(\@files,$rch); # my ($of, $rh, $dbg) = @_; # say ('tempvcscan.dsp', \%h, 0); write_hash_to_DSP2( $out_dsp, $rh, $write_dsp_dbg ); my @arr = (); push(@arr, [ $project_name, $out_dsp ]); write_proj_DSW( "builddsp.dsw", \@arr ); } show_warnings(); close_log($outfile,$load_out); exit(0); # eof - builddsp.pl