acscan03.pl to HTML.

index -|- end

Generated: Sun Aug 21 11:10:30 2011 from acscan03.pl 2010/09/19 17.4 KB.

#!/usr/bin/perl -w
# NAME: acscan03.pl
# AIM: Scan a single configure.ac file
# 15/09/2010 - Changed to use lib_utils, lib_acscan and lib_params
# 05/09/2010 - Finalize... add write amlist.txt
# 04/09/2010 - Gut and use the new lib_acscan.pl for the reading...
# 31/08/2010 - review, with better understanding of the configure.ac file)
# 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 'logfile.pl' or die "Unable to load logfile.pl ...\n";
require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl'! Check location and \@INC content.\n";
require 'lib_acscan.pl' or die "Unable to load 'lib_acscan.pl'!\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_temp_dir."\\temp.$pgmname.txt";
open_log($outfile);
my $conffile = $perl_temp_dir."\\temp.$pgmname.conf";
my $no_conf_write = 0;
my $amlistfile = $perl_temp_dir."\\amlist.txt";
my $missing_list_file = $perl_temp_dir."\\missing_list.txt";
my $write_am_list = 1;
my $only_dry_run = 0;

my $in_file = '';
my $load_log = 0;
my $abort_on_ac_config = 0; # automake requires 'AM_CONFIG_HEADER', not 'AC_CONFIG_HEADER'
my $add_all_tags = 0;   # only add those that conform to a MACRO 1:$AB\W 2:${AB} or 3:$(AB)

###############################################################
# debug
###############################################################
my $debug_on = 0;   # run without command line
my $def_file = 'C:\Projects\pcre\configure.ac';

# Debug items SHARED with LIBRARY - note use of 'our' - to adjust this list
# must als adjust the lib_acscan.pl library!!!
our $dbg_lac01 = 0; # prt( "[01] scan_..._file: Reading $file\n" ) if $dbg_lac01; and more
our $dbg_lac02 = 0; # show EACH line prt( "[02] $lnn: $cline... for each read line.
our $dbg_lac03 = 0; # prt( "[03] Variable [$key] = [$nval]\n" )
our $dbg_lac04 = 0; # prt( "[04] Split to $vlen components ...\n" )
our $dbg_lac05 = 0; # prt( "[05] Substitute [$key] = [$nval]\n" ) if ($v1 ne $v2))
our $dbg_lac06 = 0; # prt( "[06] $.: Should JOIN lines? - [$cline]\n" ) and more...
our $dbg_lac07 = 0; # prt( "[07] $.: Got AC_INIT = [$1]\n" ) and AC_DEFIN... etc
our $dbg_lac08 = 0; # prt( "[08] Got ac_output_line = $. [$rawline]\n" ) plus accumulation
our $dbg_lac09 = 0; # prt( "[01|09] Adding $input [$ff] to mk_inp_list ...\n" )
our $dbg_lac10 = 0; # prt( "[01|10] Adding $input [$ff] to other_input_files ...\n" )
our $dbg_lac11 = 0; # prt( "[11] Storing configure_cond key $1 ... value=2\n" )
our $dbg_lac12 = 0; # prt( "[12] $.: 1=[$1] = 2=[$2] NOT USED [$cline]\n" )
our $dbg_lac13 = 0; # prt("[13] $lnn: Failed on MACRO [$blk], in file [$file]\n")
our $dbg_lac14 = 0; # show each MACRO split in FULL
our $dbg_lac15 = 0; # Show each AC MACRO accumulation...
our $dbg_lac16 = 0; # Show back slash accumulation...
our $dbg_lac17 = 0; # show all substitutions
our $dbg_lac18 = 0; # show setting or replacing each macro with value
our $dbg_lac19 = 0; # unused at present
our $dbg_last = 0;

##################################################################
### program variables
my @warnings = ();
my $cwd = cwd();
my $os = $^O;
my $conf_string = '';
my ($g_in_name, $g_in_dir);

########################################
### 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; # ALL ON by default
#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 = 0;    # this is AC scan only - no sources;
our $try_much_harder = 0;   # ac scan only
# ==============================================================================
our $process_subdir = 0;
our $warn_on_plus = 0;
# ==============================================================================
# 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 $proj_incs = '/I "."';
### ========================

sub set_all_dbg_value($) {
    my ($val) = @_;
    my $rng = ac_get_dbg_range();
    my ($i);
    for ($i = 1; $i <= $rng; $i++) {
        ac_set_dbg_var($val);
    }
}

sub set_all_dbg_on() { set_all_dbg_value(1); }
sub set_all_dbg_off() { set_all_dbg_value(0); }

sub show_missing_subs($) {
    my ($val) = shift;
    my $rparams = get_ref_params();
    my $rsnf = ${$rparams}{'CURR_SUBS_NOT_FOUND'};
    my @arr = keys %{$rsnf};
    my $cnt = scalar @arr;
    my $msg = '';
    #if ($dbg_lac13) {
    if ($cnt) {
        $cnt = scalar @arr;
        prt("[13] There are at least $cnt missing substitutions.\n");
        my ($key,$fil);
        foreach $key (sort @arr) {
            $fil = ${$rsnf}{$key};
            prt("Missing [$key], in [$fil]\n") if ($dbg_lac13);
            $msg .= "-m $key \"\"\n";
        }
        if (length($missing_list_file)) {
            write2file($msg,$missing_list_file);
            prt("List written to file [$missing_list_file] for review...\n");
        } else {
            prt("Use '-d 13' to view list...\n") if (!$dbg_lac13);
        }
    } else {
        prt("[13] There are NO missing substitutions.\n") if ($val == 0);
    }
    #@arr = split $added_in_init;
    #$cnt = scalar @arr;
    #prt("But note added $cnt, [$added_in_init] in init...\n") if (length($added_in_init));
    #} elsif ($cnt && ($val == 0)) {
    #    prt("There are at least $cnt missing substitutions. Use '-d 13' to view.\n");
    #}
}

sub show_warnings() {
   if (@warnings) {
      prt( "\nGot ".scalar @warnings." WARNINGS...\n" );
      foreach my $itm (@warnings) {
         prt("$itm\n");
      }
      prt("\n");
   } else {
      prt( "\nNo warnings issued.\n\n" );
   }
}

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

    if ($val == 0) {
        my $stg = ac_get_dbg_stg();
        prt("Debug ON: $stg\n") if (length($stg));
    }

    show_missing_subs($val);

    write2file($conf_string,$conffile) if (length($conf_string) && ($val == 0) && !$no_conf_write);

    show_warnings();

    if (length($msg)) {
        $msg .= "\n" if (!($msg =~ /\n$/));
        prt($msg)
    }
    close_log($outfile,$load_log);
    exit($val);
}


sub prtw($) {
   my ($tx) = shift;
   $tx =~ s/\n$//;
   prt("$tx\n");
   push(@warnings,$tx);
}

# =====================================================================
# main services

sub write_to_am_list($$) {
    my ($ff,$ok) = @_;
    if (length($amlistfile) && $write_am_list) {
        my $dff = path_u2d($ff);
        my ($nm,$dir) = fileparse($ff);
        my $typ = 3;
        if ($ok) {
            my $lcid = lc(path_u2d($g_in_dir));
            my $lcfd = lc($dir);
            if ($lcid eq $lcfd) {
                $typ = 1;
            } else {
                $typ = 2;
            }
        }
        if (-f $amlistfile) {
            if (open INF, "<$amlistfile") {
                my @lines = <INF>;
                close INF;
                my ($line,@arr,$cnt,$fff);
                my $lcinf = lc($dff);
                foreach $line (@lines) {
                    chomp $line;
                    @arr = split(/\s/,$line);
                    $cnt = scalar @arr;
                    if ($cnt == 2) {
                        $fff = lc($arr[1]);
                        if ($fff eq $lcinf) {
                            return;
                        }
                    }
                }
            }
            append2file("$typ $dff\n",$amlistfile);
        } else {
            write2file("$typ $dff\n",$amlistfile);
        }
    }
}

sub process_ac_file($) {
    my ($inf) = @_;
    my $rparams = get_ref_params();
    return if (! -f $inf);
    ($g_in_name, $g_in_dir) = fileparse($inf);
    prt("Scanning [$inf] file...\n");
    #set_all_lib_debug();
    #set_dbg_lib_13();
    #my $rh = scan_one_configure_file($inf,$rcs);
    #my $debug_flag = -1;   # this will set them _ALL_ on
    my $debug_flag = 0;   # this should set none
    #my $debug_flag = 1 << (13 - 1);   # this will set #13 ON
    my $rng2 = ac_get_dbg_range();
    pgm_exit(1,"ERROR: Problem with ac_get_dbg_range()! is ZERO!\n") if ($rng2 == 0);

    # ======================================================
    scan_configure_ac_file($rparams);
    # ======================================================
    show_ac_hash($rparams);
}

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 ####

get_perl_temp_dir();

parse_args(@ARGV);

init_common_subs($in_file);

process_ac_file($in_file);

pgm_exit(0,"");

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

########################################
sub give_help {
    my ($tmp);
    prt("$pgmname: version 0.0.1 2010-09-15\n");
    prt("Usage: $pgmname [options] in-file\n");
    prt("Options:\n");
    prt(" --help   (-h or -?) = This help, and exit 0.\n");
    $tmp = ac_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. (def=".($load_log ? "On" : "Off").")\n");
    prt(" --mac item val (-m) = Store a MACRO, item=value, for substitution. (use '-d 13' to list missing).\n");
    prt(" --previous     (-p) = Load previous commands from [$conffile]\n") if (-f $conffile);
    prt("Purpose:\n");
    prt(" Scan the input file as a configure.ac file, and display its contents.\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");
    $tmp = ac_get_dbg_stg();
    prt(" For debug, presently values [$tmp] are ON\n") if (length($tmp));
}

sub show_dbg_help() {
    my $file = $0;
    my ($line,$max,$tmp,$cnt);
    $max = ac_get_dbg_range();
    $tmp = ac_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_lac(\d+)\s*=\s*\d+\s*;\s*(.+)$/) {
                $tmp = $1;
                prt("$tmp: $line\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,$tmp);
        foreach $line (@lines) {
            $line = trim_all($line);
            next if (length($line) == 0);
            next if ($line =~ /^#/);
            @arr = split(/\s/,$line);
            foreach $tmp (@arr) {
                $tmp = local_strip_both_quotes($tmp);
                push(@carr,$tmp);
            }
        }
        $in_input_file++;
        parse_args(@carr);
        $in_input_file--;
    } else {
        pgm_exit(1,"ERROR: Unable to 'open' file [$file]!\n")
    }
}

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

sub parse_args {
    my (@av) = @_;
    my ($arg,$sarg,$tmp);
    while (@av) {
        $arg = $av[0];
        if ($arg =~ /^-/) {
            $sarg = substr($arg,1);
            $sarg = substr($sarg,1) while ($sarg =~ /^-/);
            if (($sarg =~ /^h/i)||($sarg eq '?')) {
                give_help();
                $conf_string = "";
                pgm_exit(0,"Help exit(0)");
            } elsif ($sarg =~ /^d/i) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $conf_string .= "$arg $sarg\n";
                $tmp = ac_get_dbg_range();
                if ( ($sarg =~ /^\d+$/) && ($sarg >= 1) && ($sarg <= $tmp) ) {
                    $tmp = 'dbg';
                    if ($sarg < 10) {
                        $tmp .= "0$sarg";
                    } else {
                        $tmp .= "$sarg";
                    }
                    ac_set_dbg_var($sarg);
                    prt("Set Debug $tmp ON!\n");
                } else {
                    if ($sarg =~ /^\d+$/) {
                        pgm_exit(1,"ERROR: Invalid argument [$arg $sarg]! Out of range 1 - $tmp\n");
                    } else {
                        if ($sarg =~ /^help$/i) {
                            show_dbg_help();
                            $conf_string = "";
                            pgm_exit(0,"DEBUG Help exit(0)\n");
                        } elsif ($sarg =~ /^all$/i) {
                            prt("Setting ALL debug ON!\n");
                            set_all_dbg_on();
                        } elsif ($sarg =~ /^none$/i) {
                            prt("Setting ALL debug OFF!\n");
                            set_all_dbg_off();
                        } elsif ($sarg =~ /^dry-run$/i) {
                            prt("Setting DRY RUN ONLY!\n");
                            $only_dry_run = 1;
                        } else {
                            pgm_exit(1,"ERROR: Invalid argument [$arg $sarg]! Not numerical in range 1 - $tmp, nor 'all', 'none', or 'help' !\n");
                        }
                    }
                }
            } elsif ($sarg =~ /^l/i) {
                $conf_string .= "$arg\n";
                $load_log = 1;
            } 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} = $tmp;
                prt("Set MACRO [$sarg] = [$tmp] in common subs...\n");
                $tmp = '""' if ((length($tmp) == 0)||($tmp =~ /^\s+$/));
                $conf_string .= "$arg $sarg $tmp\n";
            } elsif ($sarg =~ /^p/i) {
                prt("Loading previous commands from [$conffile]\n");
                load_input_file($arg,$conffile);
                $no_conf_write = 1;
            } else {
                pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n");
            }
        } else {
            $in_file = File::Spec->rel2abs($arg);
            if (-f $in_file) {
                $conf_string .= "$in_file\n";
                prt("Set input to [$in_file]\n");
            } else {
                pgm_exit(1,"ERROR: Unable to locate file [$in_file]! Check name, location...\n");
            }
        }
        shift @av;
    }

    if (!$in_input_file) {
        if ((length($in_file) ==  0) && $debug_on) {
            $in_file = $def_file;
        }
        if (length($in_file) ==  0) {
            pgm_exit(1,"ERROR: No input files found in command!\n");
        }
        if (! -f $in_file) {
            pgm_exit(1,"ERROR: Can not find in file [$in_file]! Check name, location.\n");
        }
    }

}

# eof - acscan03.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional