builddsp.pl to HTML.

index -|- end

Generated: Sat Oct 12 17:22:44 2013 from builddsp.pl 2013/03/16 23.1 KB. text copy

#!/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 <<EOL' ....... '# EOL' as a SUGGESTED list of SOURCES
# Must ensure these sources are in the MIX...
# 8/15/2009 - geoff mclane - http://geoffair.net/mperl/
use strict;
use warnings;
use File::Basename;
unshift(@INC, 'C:/GTools/perl');
#require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
require 'fgutils.pl' or die "Unable to load fgutils.pl ...\n";
require 'fgdsphdrs02.pl' or die "Unable to load fgdsphdrs02.pl ...\n";
require 'chkmain.pl' or die "Unable to load chkmain.pl ...\n";
require 'lib_incinc.pl' or die "Unable to load lib_incinc.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);

my $load_out = 1;   # load, or not load the log

# libva
my $base_dir = 'C:\Projects\hb\libva';
my $in_folder = $base_dir."\\src";
my $out_folder = $base_dir.'\build\msvc';
my $project_name = "libva";
my $got_proj_name = 1;

# libgsm
#my $base_dir = 'C:\Projects\hb\gsm';
#my $in_folder = $base_dir."\\src";
#my $out_folder = $base_dir.'\build\msvc';
#my $project_name = "libgsm";
#my $got_proj_name = 1;

# liboil\liboil
#my $base_dir = 'C:\Projects\hb\liboil';
#my $in_folder = $base_dir."\\liboil";
#my $out_folder = $base_dir.'\build\msvc';
#my $project_name = "liboil";
#my $got_proj_name = 0;

# schroedinger\schroedinger
#my $base_dir = 'C:\Projects\hb\schroedinger';
#my $in_folder = $base_dir."\\schroedinger";
#my $out_folder = $base_dir.'\build\msvc';
#my $project_name = "libmkv";
#my $got_proj_name = 0;

#my $base_dir = 'C:\Projects\hb\libmkv';
#my $in_folder = $base_dir."\\src";
#my $out_folder = $base_dir.'\build\msvc';
#my $project_name = "libmkv";
#my $got_proj_name = 1;

#my $base_dir = 'C:\Projects\hb\libogg';
#my $in_folder = $base_dir."\\src";
#my $out_folder = $base_dir.'\Win32\msvc';
#my $project_name = "libogg";
#my $got_proj_name = 1;

#my $base_dir = 'C:\Projects\hb\libnut';
#my $in_folder = $base_dir."\\libnut";
#my $out_folder = $base_dir.'\Win32';
#my $project_name = "";
#my $got_proj_name = 0;

#my $base_dir = 'C:\Projects\hb\libsamplerate';
#my $in_folder = $base_dir.'\src';
#my $out_folder = $base_dir.'\Win32';
#my $project_name = "libsamplerate";
#my $got_proj_name = 1;

#my $base_dir = 'C:\Projects\hb\libiconv';
#my $in_folder = $base_dir.'\lib';
#my $out_folder = $base_dir.'\build\msvc';
#my $project_name = "libiconv";
#my $got_proj_name = 1;

#my $base_dir = 'C:\Projects\hb';
#my $in_folder = $base_dir.'\libdvdread\dvdread';
#my $out_folder = $base_dir.'\libdvdread\build\msvc';

#my $in_folder = $base_dir.'\ffmpeg\libavutil';
# C:\Projects\hb\ffmpeg\libswscale
#my $in_folder = $base_dir.'\ffmpeg\libswscale';
# my $in_folder = $base_dir.'\ffmpeg\libavformat';
#my $in_folder = $base_dir.'\ffmpeg\libavcodec';
#my $out_folder = $base_dir.'\ffmpeg\build\msvc';

##my $in_folder = 'C:\Projects\hb\HandBrake\libhb';
##my $out_folder = 'C:\Projects\hb\HandBrake\build\msvc';

my $out_dsp = 'builddsp.dsp';
my $cfg_file = 'builddsp.txt';

##my $project_name = "libiconv";
##my $got_proj_name = 1;
my $project_type = 'Static Library'; # = $app_statlib_stg;

# Options
my $exclude_main = 1;   # exclude files with 'main'...

my @exclude_files = ();

my @warnings = ();
# collected from config file
my @suggested_sources = ();

my $O_TYPE = 0;
my $C_TYPE = 1;
my $H_TYPE = 2;
my $D_TYPE = 3;

# debug options
my $dbg01 = 0;  # show scan of config file

my %type2stg = (
   $O_TYPE => 'Others',
   $C_TYPE => 'C/C++ ',
   $H_TYPE => 'Header',
   $D_TYPE => '<DIR> ');

# 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/^<//;
        $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, <DIR>, 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 <<EOL ... # EOL
# as an indication of the files that SHOULD be included
# ========================================================
sub load_config_file($$$) {
    my ($fil,$rdh,$inf) = @_;
    my (@lns,$ln, $par, $equ, $cnt, $k, $v);
    my ($tmp, $tmp2, $pn, $tmp3, $scnt, $tscnt);
    my ($end,@arr, @atmp);
    my %h = ();
    $pn = '-NEW_PROJECT_NAME-';
    if (open INF, "<$fil") {
        @lns = <INF>;
        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

index -|- top

checked by tidy  Valid HTML 4.01 Transitional