amscan02.pl to HTML.

index -|- end

Generated: Sun Aug 21 11:10:34 2011 from amscan02.pl 2010/09/22 28.4 KB.

#!/usr/bin/perl -w
# NAME: amscan02.pl
# AIM: Given a single Makefile.am, try to SCAN all in the set
# 15/09/2010 - Using only lib_amscan.pl, and lib_params.pl
# 07/09/2010 - Moving towards a lib_amscan.pl
# 05/09/2010 - Some further tidying...
# 31/08/2010 - Review (with new/better understanding of the Makefile.am ;=))
# 11/11/2008 - geoff mclane - http://geoffair.net/mperl
# ####################################################
use strict;
use warnings;
use File::Basename;    # to split path into ($name, $dir) = fileparse($ff); or ($nm,$dir,$ext) = fileparse( $fil, qr/\.[^.]*/ );
use File::Spec; # File::Spec->rel2abs($rel); # we are IN the SLN directory, get ABSOLUTE from RELATIVE
use Cwd;
my $perl_sdir = 'C:\GTools\perl';
unshift(@INC, $perl_sdir);
require 'fgutils02.pl' or die "Unable to load 'fgutils02.pl' ...\n";
require 'lib_amscan.pl' or die "Unable to load 'lib_amscan.pl'\n";
require 'lib_acscan.pl' or die "Unable to load 'lib_acscan.pl'! Check location and \@INC content.\n";
require 'lib_params.pl' or die "Unable to load 'lib_params.pl'! Check location and \@INC content.\n";
# log file stuff
my ($LF);
my $pgmname = $0;
if ($pgmname =~ /(\\|\/)/) {
    my @tmpsp = split(/(\\|\/)/,$pgmname);
    $pgmname = $tmpsp[-1];
}
my $perl_temp_dir = $perl_sdir."\\temp";
my $outfile = $perl_sdir."\\temp.$pgmname.txt";
open_log($outfile);
my $miss_mac_file = $perl_temp_dir."\\temp.missed.txt";
my $in_file = '';

my $debug_on = 0;   # run with DEFAULT, if no other input...
my $def_file = 'C:\Projects\pcre\Makefile.in';
#my $def_file = 'C:\Projects\libsigc\libsigc++-2.2.8\sigc++\Makefile.am';
#my $def_file = 'C:\Projects\libsigc\libsigc++-2.2.8\Makefile.am';
#my $def_file = 'C:\FG\FGCOMXML\libwww\Makefile.am';
my $def_targ = '';
##my $def_file = 'C:\FGCVS\gettext-0.17\Makefile.am';
##my $def_targ = "C:\\FGCVS\\gettext-0.17\\msvc\\";
##my $def_file = 'C:\Projects\zziplib-0.13.50\Makefile.am';
##my $def_file = 'C:\FGCVS\Jack\Makefile.am';
##my $def_file = 'C:\FG\PREOSG\FlightGear\source\Makefile.am';
##my $def_file = 'C:\FG\FGRUN\gettext\Makefile.am';

# features
my $load_log = 0;
my $show_per_file = 1;  # show missing on a per file basis

# program variables
my @warnings = ();
my $command_line = '';

########################################
### SHARED RESOURCES, VALUES
### ========================
our $fix_relative_sources = 1;
our %g_user_subs = (); # supplied by USER INPUT
# Auto output does the following -
# For libaries
# Debug:  '/out:"lib\barD.lib"'
# Release:'/out:"lib\barD.lib"'
# for programs
# Debug:  '/out:"bin\fooD.exe"'
# Release:'/out:"bin\foo.exe"'
# This also 'adds' missing 'include' files
our $auto_on_flag = -1;
#my ($g_in_name, $g_in_dir);
#my ($root_file, $root_folder);
#sub get_root_dir() { return $root_folder; }
our $exit_value = 0;
# But SOME Makefile.am will use specific 'paths' so the above can FAIL to find
# a file, so the following two 'try harder' options, will do a full 'root'
# directory SCAN, and search for the file of that name in the scanned files
our $try_harder = 1;
our $try_much_harder = 1;
# ==============================================================================
our $process_subdir = 0;
our $warn_on_plus = 0; # lev = 2 = Had a plus sign, is += so variable SHOULD exist
#           and warn if it does NOT, if $warn_on_plus
# ==============================================================================
# NOTE: Usually a Makefile.am contains SOURCE file names 'relative' to itself,
# which is usually without any path. This options ADDS the path to the
# Makefile.am, and then substracts the 'root' path, to get a SOURCE file
# relative to the 'root' configure.ac, which is what is needed if the DSP
# is to be placed in a $target_dir, and we want the file relative to that
our $add_rel_sources = 1;
our $target_dir = '';
# ==============================================================================
our $ignore_EXTRA_DIST = 0;
our $added_in_init = '';
our $supp_make_in = 0; # Support Makefile.in scanning
our $project_name = ''; # ***TBC*** a name to override any ac scanned name of the project
### ========================

my $proj_incs = '/I "."';

my $proj_rt = 'D'# ie use /MD and /MDd
my $proj_defs = '/D "_CRT_SECURE_NO_WARNINGS"';

# NOTE: For user includes, usually also NEED 'libpath'
# like $proj_libD .= " /libpath:\"Debug\" foo.lib";
# like $proj_libR .= " /libpath:\"Release\" foo.lib";
# OR
# like $proj_lib .= " /libpath:\"lib\";
# like $proj_libD .= " fooD.lib";
# like $proj_libR .= " foo.lib";
# sub in line ADD LINK32 kernel32.lib ... -NEW_LIBS- /nologo ...
my $proj_libs = 'Winmm.lib ws2_32.lib';
my $proj_libD = '';
my $proj_libR = '';

# NOTE: This is for say '/out:"bin\foo.exe"' or '/out:"lib\bar.lib"'
my $proj_outputR = '';
my $proj_outputD = '';

# object output, and the default for other things if NOT specifically stated
my $proj_interR = '"Release"';
my $proj_interD = '"Debug"';

# DEBUG
our $dbg_s01 = 0; # show each file line, in form "[01] $i2: [$line]"
our $dbg_s02 = 0; # show extraction from hash, like "Listing $acnt keys in hash ..."
our $dbg_s03 = 0; # show "Find sources for $val LIBRARY keys ...\n" and MORE
our $dbg_s04 = 0; # show prt( "LIBRARY [$ky] has SOURCES [$val]
our $dbg_s05 = 0; # show prt( "$am ". ((-f $am) ? "ok" : "no find!")
our $dbg_s06 = 0; # show prt( "Opened cond_stack with [".$cond_stack[$#cond_stack]."] $fil
our $dbg_s07 = 0; # add new line before 'Processing $cnt lines..., as does 08 also...
our $dbg_s08 = 0; # show prt( "Processing $cnt lines from $fil ...
our $dbg_s09 = 0; # show prt( "Got $cnt subdirectories [$slist] ...
our $dbg_s10 = 0; # show prtw("WARNING:1: No substitution for [$ms] found in hash ...
our $dbg_s11 = 0; # show target: gathering of lines...
our $dbg_s12 = 0; # show setting key=value in hash, during am file scan
our $dbg_s13 = 0; # show initial substitution, during am file scan
our $dbg_s14 = 0; # similar to about, but only show NO sub FOUND
our $dbg_s15 = 0; # List each source, for each project...
our $dbg_s16 = 0; # Like [02] list ALL keys showing dispostion
our $dbg_s17 = 0; # Out CHECK ME - SHOULD THIS ITEMS BE INCLUDED for a prog,lib,src key, now skipped!
our $dbg_s18 = 0; # show change due to adding relative directory
our $dbg_s19 = 0; # show finds found by directory searching...
our $dbg_s20 = 0; # output list of sources and header from dir scan, NOT included in a project
our $dbg_s21 = 0; # prt("\n[21] Seeking 'all' or 'default' in $cnt keys...\n"), and MORE...
my $am_check_tot = 21;
my $check_sum = $am_check_tot;

my $cwd = cwd();
my $os = $^O;

#####################################################
######## SUBS ONLY ###########
#####################################################
# FOR DEBUG
my $dbg_base = 'dbg_s';

sub set_dbg_base($) { $dbg_base = shift; }

sub get_dbg_var($) {
    my $val = shift;
    my $var = $dbg_base;
    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_base;
    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_base;
    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);
    }
}

# ###########################################################
# get DSP replacement values
# ==========================
sub get_user_rt($$) {
    my ($flag,$line) = @_;
    my $urt = '';
    if ($proj_rt eq 'D') {
        if ($flag == 1) {
            $urt = '/MD';
        } else {
            $urt = '/MDd';
        }
    } else {
        if ($flag == 1) {
            $urt = '/MT';
        } else {
            $urt = '/MTd';
        }
    }
    return $urt;
}

# NOTE: Bit 1 == Release, else Debug
sub get_user_libs($$) {
    my ($flag,$line) = @_;
    my $var1 = $proj_libs;
    if ($flag & 1) {
        if (length($proj_libR)) {
            $var1 .= " " if (length($var1));
            $var1 .= $proj_libR;
        }
    } elsif (length($proj_libD)) {
        $var1 .= " " if (length($var1));
        $var1 .= $proj_libD;
    }
    return $var1;
}

sub get_user_incs($$) {
    my ($flag,$line) = @_;
    return $proj_incs;
}

sub get_user_defs($$) {
    my ($flag,$line) = @_;
    return $proj_defs;
}

# Auto output does the following -
# For libaries
# Debug:  '/out:"lib\barD.lib"'
# Release:'/out:"lib\barD.lib"'
# for programs
# Debug:  '/out:"bin\fooD.exe"'
# Release:'/out:"bin\foo.exe"'
# our $auto_on_flag = -1 = ${$rparams}{'CURR_AUTO_ON_FLAG'}
sub get_user_output($$) {
    my ($flag,$line) = @_;
    if ($flag & 1) {
        if (length($proj_outputR)) {
            $line = $proj_outputR;
        }
    } elsif (length($proj_outputD)) {
        $line = $proj_outputD;
    }
    return $line;
}

sub get_user_inter($$) {
    my ($flag,$line) = @_;
    if ( $flag & 1 ) {
        if (length($proj_interR)) {
            $line = $proj_interR;
        }
    } elsif (length($proj_interD)) {
        $line = $proj_interD;
    }
    return $line;
}

# setting defines and include
sub add_defined_item($) {
    my $txt = shift;
    $txt = '/D "'.$txt.'"';
    $proj_defs .= ' ' if (length($proj_defs));
    $proj_defs .= $txt;
    $proj_defs = eliminate_dupes($proj_defs);
    prt("Added [$txt] to compiler defines.\n");
}

sub add_include_item($) {
    my $txt = shift;
    $txt = '/I "'.$txt.'"';
    $proj_incs .= ' ' if (length($proj_incs));
    $proj_incs .= $txt;
    $proj_incs = eliminate_dupes($proj_incs);
    prt("Added [$txt] to compiler includes.\n");
}

# ###########################################################

######################################################

sub show_missing_subs($) {
    my ($val) = @_;
    my $rparams = get_ref_params();
    my $rsnf = ${$rparams}{'CURR_SUBS_NOT_FOUND'};
    if ($dbg_s13 || $dbg_s14) {
        my @arr = keys %{$rsnf};
        my ($cnt,$txt,$key,$fil,$val,%hash);
        $txt = '';
        if (@arr) {
            $cnt = scalar @arr;
            prt("[13|14] There are at least $cnt missing substitutions.\n");
            $txt = "# [13|14] There are at least $cnt missing substitutions.\n";
            if ($show_per_file) {
                %hash = ();
                foreach $key (@arr) {
                    $fil = ${$rsnf}{$key};
                    push(@{$hash{$fil}},$key);
                }
                foreach $fil (keys %hash) {
                    $val = $hash{$fil};
                    $cnt = scalar @{$val};
                    $txt .= "# Missing $cnt from file [$fil]\n";
                    prt("Missing $cnt [");
                    foreach $key (sort @{$val}) {
                        $txt .= "-m $key \"\"\n";
                        prt("$key ");
                    }
                    prt("] from file [$fil]\n");
                }
            } else {
                foreach $key (sort @arr) {
                    $fil = ${$rsnf}{$key};
                    prt("Missing [$key], in [$fil]\n");
                    $txt .= "-m $key \"\"\n";
                }
            }
        } else {
            prt("[13|14] There are NO missing substitutions.\n");
        }
        @arr = split(/\s/,$added_in_init);
        $cnt = scalar @arr;
        if ($cnt) {
            prt("But note ADDED $cnt items, during init...");
            if (length($miss_mac_file) && (length($txt))) {
                $txt .= "# Note the following set of $cnt items were added during init...\n";
                %hash = ();
                init_common_subs2(\%hash,0);
                $cnt = 0;
                foreach $key (@arr) {
                    if (defined $hash{$key}) {
                        $val = $hash{$key};
                        if ( (length($val) == 0) || ($val =~ /^\s+$/) ) {
                            $val = '""';
                        }
                        $txt .= "-m $key $val\n";
                        $cnt++;
                    }
                }
                prt(" also now added to response file...");
            }
            prt("\n");
        }
        if (length($miss_mac_file) && (length($txt))) {
            write2file($txt,$miss_mac_file);
            prt("Written list for use as '-r $miss_mac_file' response file, after correction.\n");
        }
    }
}

my %warned_done = ();
my $warning_count = 0;
sub prtw($) {
    my ($tx) = shift;
    $tx =~ s/\n$// if ($tx =~ /\n$/);
    prt("$tx\n");
    if (!defined $warned_done{$tx}) {
        push(@warnings,$tx);
        $warned_done{$tx} = 1;
    }
    $warning_count++;
}

sub show_warnings($) {
    my $val = shift;
    if (@warnings) {
        my $wcnt = scalar @warnings;
        my $msg = '';
        my $diff = $warning_count - $wcnt;
        $msg = "Note $diff duplicates NOT repeated." if ($diff);
        prt( "\nRepeat of $wcnt WARNINGS... $msg\n" );
        foreach my $line (@warnings) {
            prt("$line\n" );
        }
        prt("\n");
    } elsif ($val) {
        prt("\nNo warnings issued.\n\n");
    }
}


sub pgm_exit($$) {
    my ($val,$msg) = @_;

    show_warnings($val);

    show_missing_subs($val);

    if (length($msg)) {
        prt("\a\n") if ($msg =~ /^ERROR/);
        $msg =~ s/\n$//;
        $msg .= " time:".localtime(time())."\n";
        prt($msg);
    }
    
    close_log($outfile,$load_log);
    exit($val);
}

sub sub_common_folder {
    my ($fil,$root) = @_;
    my $lfil = lc(path_u2d($fil));
    my $lrot = lc(path_u2d($root));
    my $len1 = length($lfil);
    my $len2 = length($lrot);
    my ($i);
    for ($i = 0; (($i < $len1)&&($i < $len2)); $i++) {
        if (substr($lfil,$i,1) ne substr($lrot,$i,1)) {
            last;
        }
    }
    return substr($fil,$i);
}

sub sub_root_folder_BAD {
    my ($fil) = shift;
    my $rd = get_root_dir();
    return sub_common_folder($fil,$rd);
}

sub begins_with {
    my ($rt, $pt) = @_;
    my $ln = length($rt);
    if (length($pt) >= $ln) {
        for (my $i = 0; $i < $ln; $i++) {
            if (substr($rt,$i,1) ne substr($pt,$i,1)) {
                return 0;
            }
        }
        return 1;
    }
    return 0;
}

# forward
sub process_one_am_file($);

# VARIOUS FIXES FOR THE FILE NAME
# 1. ensure ALL DOS format
# 2. remove any simple dot relative, like '.\' from beginning
# 3. if given a FULL PATH name, remove C:\FG\20\FlightGear
# 4. if a relative name, remove FligthGear
# 5. if any removal, ensure any beginning '\' is removed
sub sub_root_dir($) {
    my ($ff) = shift;   # = $a_dir.$src
    $ff = path_u2d($ff);
    my $rd = get_root_dir();
    if (begins_with($rd, $ff)) {
        $ff = substr($ff, length($rd));
    }
    return $ff;
}

sub sub_root_folder {
    my ($fil) = shift;
    return sub_root_dir($fil);
}


sub process_one_am_file($) {
    my ($rparams) = @_;
    my $ramsdone = ${$rparams}{'REF_AMS_DONE'};
    my $fil = ${$rparams}{'AM_FILE'};
    $fil = fix_rel_path3($fil,'process_one_am_file');
    my $sfil = sub_root_folder($fil);

    return if (defined ${$ramsdone}{$fil});

    ${$ramsdone}{$fil} = 1;

    my $ramh = am_process_AM_file($rparams);
    my ($p_tit,$p_dir,$p_ext) = fileparse( $fil, qr/\.[^.]*/ );
    my $do_subs = ${$rparams}{'PROCESS_SUBDIR'};
    if ($do_subs && (defined ${$ramh}{'SUBDIRS'})) {
        my $slist = ${$ramh}{'SUBDIRS'};
        my @ar = split(/\s/,$slist);
        my $cnt = scalar @ar;
        prt( "[09] Got $cnt subdirectories [$slist] ...from [$sfil]\n" ) if ($dbg_s09);
        foreach my $dir (@ar) {
            my $am = $p_dir.$dir.'\Makefile.am';
            $am = path_u2d($am);
            $am =~ s/\\\\/\\/g while ($am =~ /\\\\/);
            my $sam = sub_root_folder($am);
            if (-f $am) {
                prt( "[05] Processing AM file [$am], from [$fil] ...\n" ) if ($dbg_s05);
                ${$rparams}{'AM_FILE'} = $am;
                process_one_am_file($rparams);
                ${$rparams}{'AM_FILE'} = $fil;
            } else {
                prtw( "[05] WARNING: AM [$am] NOT FOUND! in [$dir], from [$fil]!\n" ) if ($dbg_s05);
            }
        }
    } 
    return $ramh;
}



sub process_primary($) {
    my ($fil) = shift;
    my $rparams = get_ref_params();
    ${$rparams}{'AM_FILE'} = $fil;

    my $rh = process_one_am_file($rparams);  # iteratively process the Makefile.am files
    #list_to_arrays($fil,\%g_programs,\%g_libraries,\%g_ams_done);
    am_list_to_arrays($rparams);
    ##write_temp_dsp($dsp_outfile);
}

sub get_perl_temp_dir() {
    if (! -d $perl_temp_dir) {
        mkdir $perl_temp_dir;
        if (! -d $perl_temp_dir) {
            pgm_exit(1,"ERROR: Unable to create directory [$perl_temp_dir]\nMaybe there is already a file of that name, or...\n");
        }
    }
}

#############################################################
##### MAIN #####
set_dbg_base("dbg_s");

#set_debug_none();
#set_debug_all();
pgm_exit(1,"ERROR: Debugging is FAILING! check-sum=$check_sum, dbg = ".get_dbg_range()."!\n") if (get_dbg_range() != $check_sum);

get_perl_temp_dir();

parse_args(@ARGV);

init_common_subs( $in_file );

process_primary( $in_file );

pgm_exit($exit_value,"CMD: [".$command_line."] Normal Exit");

##############################################################

sub give_help {
    my ($tmp);
    prt("$pgmname: version 0.2.2 2010-09-22. See amsrcs04.pl for full implementation.\n");
    prt("Usage: $pgmname [options] in-file\n");
    prt("Options:\n");
    prt(" --help   (-h or -?) = This help, and exit 0.\n");
    $tmp = get_dbg_range();
    prt(" --dbg <num>    (-d) = Set DEBUG flag of this value. Number in range 1 to $tmp\n");
    prt(" --load-log     (-l) = Load LOG file at end.\n");
    prt(" --mac item val (-m) = Store a MACRO, item=value, for substitution. (use '-d 14' to list missing).\n");
    prt(" --name <name>  (-n) = Overrride any name in the AC_INIT/AM_INIT_AUTOMAKE.\n");
    prt(" --quick        (-q) = Be quick. This turn OFF any directory scanning for sources.\n");
    prt(" --supp_in      (-s) = Suupport Makefile.in, if NO Makefile.am. (def=$supp_make_in)\n");
    prt(" --SUBDIR       (-S) = Process SUBDIR entries, and ALL Makefile.am files found.\n");
    prt(" --resp <file>  (-r) = Commands from a reponse/input file.\n");
    prt(" --targ <dir>   (-t) = Establish a target directory for the DSW/DSP files.\n");
    prt("Purpose:\n");
    prt("Read the file given as a GNU Makefile.am autotools project description file, and\n");
    prt("show its contents. If the --subdir (-s) command is given, and it contains any SUBDIRS = macro,\n");
    prt("then it check each sub-directory for a Makefile.am file, and if found, process it also.\n");
    prt("NOTES:\n");
    prt(" The debug switch is strictly for that. It adds no functionality, just a noisier output,\n");
    prt("  and has the text settings of 'all', 'none', or 'help', to show the list in more detail.\n");
    prt(" While this script does NOT output DSW/DSP files, if given a target directory, the source file\n");
    prt("  lists for each project source listed will be adjusted as if the DSP file was in this target\n");
    prt("  directory. The default will be the same directory as the primary Makefile.am file.\n");
    prt(" This script does NOT function with a Makefile.in, which is more like a 'standard' makefile that\n");
    prt("  would be used by the 'make', or 'nmake' tools in windows.\n");
    prt(" Unless there are two commands using the same letter, normally case is ignored.\n");

    $tmp = get_dbg_stg();
    prt(" For debug, presently values [$tmp] are ON\n") if (length($tmp));
}

sub need_arg {
    my ($arg,@av) = @_;
    pgm_exit(1,"ERROR: [$arg] must have following argument!\n") if (!@av);
}

sub show_dbg_help() {
    my $file = $0;
    my ($line,$max,$tmp,$cnt,$tmp2);
    $max = get_dbg_range();
    $tmp = get_dbg_stg();
    prt(" --dbg <num>  (-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 = <INF>;
        close INF;
        prt(" Detailed list, with some 'notes' indicating what each does.\n");
        $cnt = 0;
        foreach $line (@lines) {
            $line = trim_all($line);
            if ($line =~ /^our\s+\$dbg_s(\d+)\s*=\s*\d+\s*;\s*#(.+)$/) {
                $tmp = $1;
                $tmp2 = $2;
                prt("$tmp: $tmp2\n");
                $cnt++;
            }
        }
        prt("ERROR: Found no \$dbg?? vars in file [$file], so NO DEBUG ADDITIONAL HELP!\n") if (!$cnt);
    } else {
        prt("ERROR: Unable to open file [$file], so NO DEBUG ADDITIONAL HELP!\n");
    }
}

sub local_strip_both_quotes($) {
    my $txt = shift;
    if ($txt =~ /^'(.+)'$/) {
        return $1;
    }
    if ($txt =~ /^"(.+)"$/) {
        return $1;
    }
    return '' if ($txt eq '""');
    return '' if ($txt eq "''");
    #prt("Stripping [$txt] FAILED\n");
    return $txt;
}

my $in_input_file = 0;
sub load_input_file($$) {
    my ($arg,$file) = @_;
    if (open INF, "<$file") {
        my @lines = <INF>;
        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);
        }
        $in_input_file++;
        parse_args(@carr);
        $in_input_file--;
    } else {
        pgm_exit(1,"ERROR: Unable to 'open' file [$file]!\n")
    }
}


sub set_debug_all() {
    my $cnt = am_get_dbg_range();
    prt("Setting DEBUG 01 to $cnt ON\n");
    am_set_all_dbg_on();
}
sub set_debug_none() {
    my $cnt = am_get_dbg_range();
    prt("Setting DEBUG 01 to $cnt OFF\n");
    am_set_all_dbg_off();
}

sub add_to_commands($) {
    my ($rav) = @_;
    my ($tmp);
    foreach $tmp (@{$rav}) {
        $command_line .= ' ' if (length($command_line));
        $command_line .= $tmp;
    }
}

sub parse_args {
    my (@av) = @_;
    my ($arg,$sarg,$tmp,$rng);
    add_to_commands(\@av);
    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");
            } elsif ($sarg =~ /^d/i) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $rng = get_dbg_range();
                if (($sarg =~ /^\d+$/) && ($sarg >= 1) && ($sarg <= $rng)) {
                    $tmp = 'dbg';
                    if ($sarg < 10) {
                        $tmp .= "0$sarg";
                    } else {
                        $tmp .= "$sarg";
                    }
                    set_dbg_var($sarg);
                    prt("Set Debug $tmp ON! (of $rng)\n");
                } else {
                    if ($sarg =~ /^\d+$/) {
                        pgm_exit(1,"ERROR: Invalid argument [$arg $sarg]! Out of range 1 - $rng\n");
                    } else {
                        if ($sarg =~ /^help$/i) {
                            show_dbg_help();
                            pgm_exit(0,"DEBUG Help exit(0)\n");
                        } elsif ($sarg =~ /^all$/i) {
                            set_all_dbg_on();
                            $tmp = get_dbg_stg();
                            prt("Set ALL debug ON! 1 to $rng [$tmp]\n");
                        } elsif ($sarg =~ /^none$/i) {
                            set_all_dbg_off();
                            $tmp = get_dbg_stg();
                            prt("Setting ALL debug OFF! 1 to $rng [$tmp]\n");
                        } else {
                            pgm_exit(1,"ERROR: Invalid argument [$arg $sarg]! Not numerical in range 1 - $tmp, nor 'all', 'none', or 'help' !\n");
                        }
                    }
                }
            } elsif ($sarg =~ /^m/i) {
                # store a macro
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                need_arg(@av);
                shift @av;
                $tmp = $av[0];
                $g_user_subs{$sarg} = local_strip_both_quotes($tmp);
                prt("Set MACRO $sarg = [$tmp] in common subs...\n");
            } elsif ($sarg =~ /^n/i) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $project_name = $sarg;
                prt("Set default over-all project name to [$project_name]\n");
            } elsif ($sarg =~ /^q/i) {  # quick = no directory scan
                $try_harder = 0;
                $try_much_harder = 0;
                prt("Turned OFF the try harder directory scans, if needed.\n");
            } elsif ($sarg =~ /^r/i) {  # response file
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                load_input_file($arg,$sarg);
            } elsif ($sarg =~ /^s/) {
                $supp_make_in = 1;
                prt("Added support for Makefile.in.\n");
            } elsif ($sarg =~ /^S/) {  # process SUBDIR entries
                $process_subdir = 1;
                prt("Set to process SUBDIR entries, if found.\n");
            } elsif ($sarg =~ /^t/i) {  # target directory for DSP file(s)
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $target_dir = File::Spec->rel2abs($sarg);
                $fix_relative_sources = 1;
                prt("Set to TARGET folder to [$target_dir].\n");
            } 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 (!$in_input_file) {
        if ((length($in_file) ==  0) && $debug_on) {
            $in_file = $def_file;
            $target_dir = $def_targ if (length($target_dir) == 0);
            #$load_log = 1;
            #$process_subdir = 1;
            #prt("[debug_on] Set to process SUBDIR entries, if found.\n");
            $rng = get_dbg_range();
            set_all_dbg_on();
            $tmp = get_dbg_stg();
            prt("[debug_on] Set ALL debug ON! 1 to $rng [$tmp]\n");
        }

        if (length($in_file) ==  0) {
            pgm_exit(1,"ERROR: No input files found in command!\n");
        }

        $in_file = path_u2d($in_file);
        if (! -f $in_file) {
            pgm_exit(1,"ERROR: Input file [$in_file] NOT FOUND!\n");
        }
    }
    #wait_key();
}

# eof - amscan02.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional