QtPro.pl to HTML.

index -|- end

Generated: Sun Apr 15 11:46:40 2012 from QtPro.pl 2011/12/01 24.1 KB.

#!/usr/bin/perl -w
# NAME: qtpro.pl
# AIM: Read a QT pro (project) file, and check Buttons and Text Edit fields
# have 'connection'...
# 30/11/2011 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_dir = 'C:\GTools\perl';
unshift(@INC, $perl_dir);
require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl' Check paths in \@INC...\n";
# log file stuff
our ($LF);
my $pgmname = $0;
if ($pgmname =~ /(\\|\/)/) {
    my @tmpsp = split(/(\\|\/)/,$pgmname);
    $pgmname = $tmpsp[-1];
}
my $outfile = $perl_dir."\\temp.$pgmname.txt";
open_log($outfile);

# Reading the PRO file
# Commence with '#' comment
# QT       += core gui
# TARGET = TgTake2
# TEMPLATE = app
# SOURCES += main.cpp\
#        mainwindow.cpp
# HEADERS  += mainwindow.h \
#    app_config.h

my %qtclasses = (
   'QButtonGroup' => 1,
   'QLineEdit' => 1,
   'QLabel' => 0,
   'QListWidget' => 1,
   'QCheckBox' => 1,
   'QPushButton' => 1,
   'QPlainTextEdit' => 0,
   'QApplication' => 0,
   'QChar' => 0,
   'QDateTime' => 0,
   'QDesktopServices' => 0,
   'QDialog' => 0,
   'QDir' => 0,
   'QFile' => 0,
   'QFileDialog' => 0,
   'QFileInfo' => 0,
   'QFileInfoList' => 0,
   'QFont' => 0,
   'QFontDatabase' => 0,
   'QGridLayout' => 0,
   'QGroupBox' => 0,
   'QHBoxLayout' => 0,
   'QLayout' => 0,
   'QList' => 0,
   'QMap' => 0,
   'QMessageBox' => 0,
   'QProcess' => 0,
   'QRadioButton' => 0,
   'QRegExp' => 0,
   'QSettings' => 0,
   'QSizePolicy' => 0,
   'QSpacerItem' => 0,
   'QStringList' => 0,
   'QTableWidgetItem' => 0,
   'QTextStream' => 0,
   'QTime' => 0,
   'QUrl' => 0,
   'QVBoxLayout' => 0,
   'QWidget' => 0,
   'QXmlStreamReader' => 0,
   'Q_UNUSED' => 0,
    'QString' => 0 
    );

my %g_qtmissed = ();

# user variables
my $VERS = "0.0.1 2011-11-30";
my $load_log = 0;
my $in_file = '';
my $verbosity = 0;
my $debug_on = 1;
my $def_file = 'C:\Qt\2010.05\qt\examples\test\TgTake2\src\TgTake2.pro';
my $out_xml = '';
my $tmp_out = $perl_dir."\\tempall.txt";

### program variables
my @warnings = ();
my $cwd = cwd();
my $os = $^O;

### DEBUG
my $dbg_01 = 0; # show comment begin/end
my $dbg_02 = 0; # show file processing
my $dbg_03 = 0; # show include files
my $dbg_04 = 0; # show EACH line
my $dbg_05 = 0; # show cleaned line count, when collecting ALL lines 

# forward references
sub process_curr_lines($);

sub VERB1() { return $verbosity >= 1; }
sub VERB2() { return $verbosity >= 2; }
sub VERB5() { return $verbosity >= 5; }
sub VERB9() { return $verbosity >= 9; }

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

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


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

sub process_in_file($) {
    my ($inf) = @_;
    if (! open INF, "<$inf") {
        pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); 
    }
    my @lines = <INF>;
    close INF;
    my $lncnt = scalar @lines;
    prt("Processing $lncnt lines, from [$inf]...\n");
    my ($i,$line,$inc,$lnn,$tmp,@arr,$val,$cnt,$file,$ff,$ok);
    $lnn = 0;
    my ($path);
    if ($os =~ /win/i) {
        $path = \&path_u2d;
    } else {
        $path = \&path_d2u;
    }
    $inf = $path->($inf);
    my ($nm,$dir) = fileparse($inf);
    my @sources = ();
    my @headers = ();
    my %hash = ();
    my %dupes = ();
    $hash{'CURR_INPUT'} = $inf;
    $hash{'CURR_FILENAME'} = $nm;
    $hash{'CURR_DIRECTORY'} = $dir;
    for ($i = 0; $i < $lncnt; $i++) {
        $line = trim_all($lines[$i]);
        $lnn++;
        next if (length($line) == 0);
        next if ($line =~ /^\#/);
        while (($i < $lncnt) && ($line =~ /\\$/)) {
            $line =~ s/\\$//;
            $line .= ' ' if ($line =~ /\S$/);
            $i++;
            $line .= trim_all($lines[$i]);
        }
        @arr = split("=",$line);
        $cnt = scalar @arr;
        $val = ($cnt > 1) ? $arr[1] : 'Unknown';
        
        # QT       += core gui
        # TARGET = TgTake2
        # TEMPLATE = app
        # SOURCES += main.cpp\
        #        mainwindow.cpp
        # HEADERS  += mainwindow.h \
        #    app_config.h
        if ($line =~ /^QT(\s|\+|=)/) {
            prt("QT modules: $val\n");
            $hash{'CURR_QTMODS'} = $val;
        } elsif ($line =~ /^TARGET(\s|\+|=)/) {
            prt("TARGET    : $val\n");
            $hash{'CURR_TARGET'} = $val;
        } elsif ($line =~ /^TEMPLATE(\s|\+|=)/) {
            prt("TEMPLATE  : $val\n");
            $hash{'CURR_TEMPLATE'} = $val;
        } elsif ($line =~ /^SOURCES(\s|\+|=)/) {
            #prt("SOURCES   : $val\n");
            @arr = split(/\s+/,$val);
            $cnt = scalar @arr;
            prt("SOURCES   : $cnt\n");
            foreach $file (@arr) {
                next if (length($file) == 0);
                $ff = $dir.$file;
                $ff = $path->($ff);
                $ok = "NOT FOUND!";
                if (-f $ff) {
                    $ok = "ok";
                }
                if (defined $dupes{$file}) {
                    prtw("WARNING: Duplicated file name [$file]\n");
                } else {
                    $dupes{$file} = 1;
                    push(@sources,$ff);
                    prt(" $ff $ok\n") if (VERB9());
                }
            }
        } elsif ($line =~ /^HEADERS(\s|\+|=)/) {
            #prt("HEADERS   : $val\n");
            @arr = split(/\s+/,$val);
            $cnt = scalar @arr;
            prt("HEADERS   : $cnt\n");
            foreach $file (@arr) {
                next if (length($file) == 0);
                $ff = $dir.$file;
                $ff = $path->($ff);
                $ok = "NOT FOUND!";
                if (-f $ff) {
                    $ok = "ok";
                }
                if (defined $dupes{$file}) {
                    prtw("WARNING: Duplicated file name [$file]\n");
                } else {
                    $dupes{$file} = 1;
                    push(@headers,$ff);
                    prt(" $ff $ok\n") if (VERB9());
                }
            }
        } else {
            prtw("WARNING: WHAT IS THIS? [$line]\n");
        }
    }
    $hash{'SOURCES'} = \@sources;
    $hash{'HEADERS'} = \@headers;
    return \%hash;
}

sub process_cleaned_lines($) {
    my ($rh) = @_;
    if (! defined ${$rh}{'CURR_FILE'}) {
        prtw("WARNING: No 'CURR_FILE' in reference hash!\n");
        return 1;
    }
    my $ff = ${$rh}{'CURR_FILE'};
    if (! defined ${$rh}{'CURR_FILE_HASH'}) {
        prtw("WARNING: No 'CURR_FILE_HASH' in reference hash!\n");
        return 1;
    }
    my $rfh = ${$rh}{'CURR_FILE_HASH'};
    if (! defined ${$rfh}{$ff} ) {
        prtw("WARNING: No '$ff' in reference hash!\n");
        return 1;
    }
    my $rla = ${$rfh}{$ff}; # = \@newlines;
    my $lncnt = scalar @{$rla};
    prt("Got $lncnt cleaned lines from [$ff] to process...\n");
    ${$rh}{'CURR_LINES'} = $rla;

    process_curr_lines($rh);

    return 0;
}


sub process_source($) {
    my ($rh) = @_;
    my $ff = ${$rh}{'CURR_FILE'};
    if (! open FIL, "<$ff") {
        prtw("WARNING: Unable to open file [$ff]!\n");
        return;
    }
    my @lines = <FIL>;
    close FIL;
    my $lncnt = @lines;
    my ($i,$i2,$ib,$line,$len,$ch,$nc,$j,$j2,$qc,$tline);
    my $inquot = 0;
    my $incomm = 0;
    my $bgnquot = '';
    my $nline = '';
    prt("Process $lncnt lines, from [$ff]\n") if ($dbg_02 || VERB9());
    my @newlines = ();
    for ($i = 0; $i < $lncnt; $i++) {
        $ib = $i + 1;
        $line = trim_tailing($lines[$i]);
        while (($i < $lncnt) && ($line =~ /\\$/)) {
            $line =~ s/\\$//;
            $line .= ' ' if ($line =~ /\S$/);
            $i++;
            $line .= trim_tailing($lines[$i]);
        }
        $i2 = $i + 1;
        $len = length($line);
        for ($j = 0; $j < $len; $j++) {
            $ch = substr($line,$j,1);
            $j2 = $j + 1;
            $nc = ($j2 < $len) ? substr($line,$j2,1) : '';
            if ($incomm) {
                if (($ch eq '*')&&($nc eq '/')) {
                    $incomm = 0;
                    prt("$i2:$j2: End comment\n") if ($dbg_01);
                    $j++;   # bump past next char
                }
                next;
            } elsif (($ch eq '/')&&($nc eq '*')) {
                $incomm = 1;
                prt("$i2:$j2: Begin comment\n") if ($dbg_01);
                next;
            } elsif (($ch eq '/')&&($nc eq '/')&&(!$inquot)) {
                prt("$i2:$j2: Comment line\n") if ($dbg_01);
                last; # end of this line
            }
            if ($inquot) {
                $inquot = 0 if ($ch eq $qc);
            } elsif (($ch eq '"')||($ch eq "'")) {
                $inquot = 1;
                $bgnquot = "$i2:$j2: Begin quote $ch";
                $qc = $ch;
            }
            # not comment
            if ($ch =~ /\s/) {
                if (length($nline) && ($nline =~ /\S$/)) {
                    $nline .= $ch;
                }
            } else {
                $nline .= $ch;
            }
        }
        prtw("WARNING: $i2: End line in quotes! [$bgnquot] [$line]\n [$ff]\n") if ($inquot);
        $inquot = 0;
        $nline = trim_tailing($nline);
        push(@newlines,$nline) if (length($nline));
        $nline = '';
    }
    my $rfh = ${$rh}{'CURR_FILE_HASH'};
    ${$rfh}{$ff} = \@newlines;
    process_cleaned_lines($rh);
}

sub show_includes($) {
    my ($rh) = @_;
    my ($key,$seek);
    # seek ${$rh}{'CURR_INCLUDES:'.$ff} = \%incs;
    # ${$rh}{'CURR_FILE'} = 'CURR_ALL_FILES';
    $seek = 'CURR_INCLUDES:CURR_ALL_FILES';
    if ( ! defined ${$rh}{$seek} ) {
        prt("Unable to locate key [$seek] in hash!\n");
        return 1;
    }
    my $rih = ${$rh}{$seek};
    my @keys = sort keys(%{$rih});
    my $cnt = scalar @keys;
    prt("Found $cnt 'include' items, under key [$seek]\n");
    foreach $key (@keys) {
        prt("#include <$key>\n");
    }
}

sub get_first_token($) {
    my ($line) = shift;
    my $len = length($line);
    my $tok = '';
    my ($i,$ch);
    ### prt("Get first token [$line]$len\n");
    for ($i = 0; $i < $len; $i++) {
        $ch = substr($line,$i,1);
        if ($ch =~ /\w/) {
            $tok .= $ch;
        } elsif (length($tok)) {
            last;
        }
    }
    return $tok;
}

sub show_array($) {
    my ($ra) = shift;
    my ($item);
    foreach $item (@{$ra}) {
        prt(" $item\n");
    }
}

sub show_class_items($) {
    my ($rh) = @_;
    my $ff = ${$rh}{'CURR_FILE'};   # store results under this NAME
    my $cname = ${$rh}{'CURR_CLASS_NAME:'.$ff};
    my $rpriv = ${$rh}{'CURR_CLASS_PRIVATE:'.$ff};  # = \@private;
    my $rpubl = ${$rh}{'CURR_CLASS_PUBLIC:'.$ff};   # = \@public;
    my $rsigs = ${$rh}{'CURR_CLASS_SIGNALS:'.$ff};  # = \@signals;
    my $rslot = ${$rh}{'CURR_CLASS_SLOTS:'.$ff};    # = \@slots;
    my $pricnt = scalar @{$rpriv};
    my $pubcnt = scalar @{$rpubl};
    my $sigcnt = scalar @{$rsigs};
    my $slocnt = scalar @{$rslot};
    my $totcnt = ($pricnt+$pubcnt+$sigcnt+$slocnt);
    if ($totcnt) {
        prt("class $cname - $totcnt items\n");
    } else {
        prt("class $cname - Declaration only. No body\n");
    } 

    if ($pricnt) {
        prt("private: $pricnt items...\n");
        show_array($rpriv) if (VERB9());
    }
    if ($pubcnt) {
        prt("public: $pubcnt items...\n");
        show_array($rpubl) if (VERB9());
    }
    if ($sigcnt) {
        prt("signals: $sigcnt items...\n");
        show_array($rsigs) if (VERB9());
    }
    if ($slocnt) {
        prt("slots: $slocnt items...\n");
        show_array($rslot) if (VERB9());
    }
}

sub collect_class($) {
    my ($rh) = @_;
    # ${$rh}{'CURR_OFF'} = $i;    # current line being processed
    my $off = ${$rh}{'CURR_OFF'};
    my $rala = ${$rh}{'CURR_LINES'};
    my $lncnt = ${$rh}{'CURR_LINE_COUNT'};
    my $ff = ${$rh}{'CURR_FILE'};   # store results under this NAME
    my $line = ${$rala}[$off];
    my $noff = $off;
    my $sline = $line;
    my $classname = '';
    if ($sline =~ /^\s*class\s+/) {
        $sline =~ s/^\s*class\s+//;
        $classname = get_first_token($sline);
    }
    if (length($classname)) {
        prt("Got class name [$classname]\n");
        $sline =~ s/$classname//;
        $sline = trim_all($sline);
    } else {
        prtw("WARNING: $off: No class name found! Using 'anon' line [$line]\n");
        $classname = 'anon';
    }
    ### prt("collect_class: begin line $noff...\n");
    if (($line =~ /^\s*class\s+/)&&($noff < $lncnt)) {
        my @braces = ();
        my @brackets = ();
        my @class = ();
        my @private = ();
        my @public = ();
        my @signals = ();
        my @slots = ();
        my $ractarr = \@private;
        my ($j,$ch,$len);
        my $isdec = 0;
        ### prt("While noff $noff is less than lncnt $lncnt\n");
        while ($noff < $lncnt) {
            $len = length($line);
            $isdec = 0;
            if ($line =~ /^\s*private\s*:/) {
                $ractarr = \@private;
                $isdec = 1;
            } elsif ($line =~ /^\s*public\s+slots\s*:/) {
                $ractarr = \@slots;
                $isdec = 1;
            } elsif ($line =~ /^\s*public\s*:/) {
                $ractarr = \@public;
                $isdec = 1;
            } elsif ($line =~ /^\s*signals\s*:/) {
                $ractarr = \@signals;
                $isdec = 1;
            } else {
                # not a (listed) declaration
                for ($j = 0; $j <$len; $j++) {
                    $ch = substr($line,$j,1);
                    if ($ch eq ';') {
                        if (!@braces && !@brackets) {
                            prt("Done class from $off to $noff\n");
                            push(@class,$line);
                            prt("class $classname\n".join("\n",@class)."\n") if (VERB9());
                            ${$rh}{'CURR_CLASS_NAME:'.$ff} = $classname;
                            ${$rh}{'CURR_CLASS_PRIVATE:'.$ff} = \@private;
                            ${$rh}{'CURR_CLASS_PUBLIC:'.$ff} = \@public;
                            ${$rh}{'CURR_CLASS_SIGNALS:'.$ff} = \@signals;
                            ${$rh}{'CURR_CLASS_SLOTS:'.$ff} = \@slots;
                            ${$rh}{'CURR_CLASS_WHOLE:'.$ff} = \@class; # all the class lines
                            show_class_items($rh);
                            return $noff;
                        }
                    } elsif ($ch eq '(') {
                        push(@brackets,$ch);
                    } elsif ($ch eq ')') {
                        if (@brackets) {
                            pop @brackets;
                        } else {
                            prtw("WARNING: Closing bracket outside stack\n");
                            return $off;
                        }
                    } elsif ($ch eq '{') {
                        push(@braces,$ch);
                    } elsif ($ch eq '}') {
                        if (@braces) {
                            pop @braces;
                        } else {
                            prtw("WARNING: Closong braces without stack!\n");
                            return $off;
                        }
                    }
                }
            }
            push(@class,$line);
            # store an item, if inside braces, and not a declaration
            push(@{$ractarr},$line) if (($isdec == 0) && @braces);
            $noff++;
            $line = ${$rala}[$noff] if ($noff < $lncnt);
        }
        # prt("Returning $off...\n");
    }
    prtw("WARNING: $classname: Failed in class collection!\n");
    return $off;
}

# QLineEdit *oneEdit;
# QLabel *oneInfo;
# QListWidget *listWidget;
# QCheckBox *useukCheck;
sub process_curr_lines($) {
    my ($rh) = @_;
    my ($line,$i,$inc,$def);
    if (! defined ${$rh}{'CURR_FILE'}) {
        prtw("WARNING: No 'CURR_FILE' in reference hash!\n");
        return 1;
    }
    my $ff = ${$rh}{'CURR_FILE'};   # store results under this NAME
    if (! defined ${$rh}{'CURR_LINES'}) {
        prtw("WARNING: No 'CURR_LINES' in reference hash!\n");
        return 1;
    }

    my $rala = ${$rh}{'CURR_LINES'};
    my $lncnt = scalar @{$rala};
    my %incs = ();
    my %defines = ();
    my %mac_defs = ();
    ${$rh}{'CURR_LINE_COUNT'} = $lncnt;
    prt("Processing $lncnt lines... for key.file $ff\n");
    for ($i = 0; $i < $lncnt; $i++) {
        ${$rh}{'CURR_OFF'} = $i;    # current line being processed
        $line = ${$rala}[$i];
        prt("$i of $lncnt: $line\n") if ($dbg_04);
        if ($line =~ /^\s*\#/) {
            # like #if #ifdef #ifndef #else #endif
            # #include
            # #define
            if ($line =~ /^\s*\#\s*if/) {
                # collect condition
                if ($line =~ /^\s*\#\s*if(\W.+)/) {
                    $inc = trim_all($1);
                } elsif ($line =~ /^\s*\#\s*ifdef(\W.+)$/) {
                    $inc = trim_all($1);
                } elsif ($line =~ /^\s*\#\s*ifndef(\W.+)$/) {
                    $inc = trim_all($1);
                } else {
                    prtw("WARNING: Check this IF [$line]\n");
                }
            } elsif ($line =~ /^\s*\#\s*else/) {
                # switch condition
            } elsif ($line =~ /^\s*\#\s*elif/) {
                # switch condition
                if ($line =~ /^\s*\#\s*elif(\W.+)/) {
                    $inc = trim_all($1);
                } else {
                    prtw("WARNING: Check this ELIF [$line]\n");
                }
            } elsif ($line =~ /^\s*\#\s*endif/) {
                # end condition
            } elsif ($line =~ /^\s*\#\s*undef/) {
                # remove definition
            } elsif ($line =~ /^\s*\#\s*include\s*/) {
                # collect includes
                if ($line =~ /^\s*\#\s*include\s*(<|")(.+)(>|")/) {
                    $inc = $2;
                    $incs{$inc} = 1;
                } else {
                    prtw("WARNING: Check include line [$line]\n");
                }
            } elsif ($line =~ /^\s*\#\s*define(\W.+)$/) {
                # collect definitions
                $inc = trim_all($1);
                if ($inc =~ /^\w+$/) {
                    $defines{$inc} = $1;
                } elsif ($inc =~ /(\w+)\s+(.+)$/) {
                    $inc = $1;
                    $def = trim_all($2);
                    $mac_defs{$inc} = $def;
                } elsif ($inc =~ /(\w+\s*\(.+\))\s+(.+)$/) {
                    $inc = $1;
                    $def = trim_all($2);
                    $mac_defs{$inc} = $def;
                } else {
                    prtw("WARNING: Check define line [$line]\n");
                }
            } elsif ($line =~ /^\s*\#\s*error/) {
                # collect errors
            } else {
                prtw("WARNING: Uncased [$line]\n");
            }
        } elsif ($line =~ /^\s*class\s+/) {
            # enter a class definition
            my $ni = collect_class($rh);
            if ($ni >= $i) {
                $i = $ni;
            } else {
                pgm_exit(1,"ERROR: collect_classes returned $ni - min is $i!\n");
            }
        } elsif ($line =~ /^\s*Q/) {
            # a Qt 'class'
            if ($line =~ /^\s*(Q\w+)\W+/) {
                $inc = $1;
                if (! defined $qtclasses{$inc}) {
                    $g_qtmissed{$inc} = 1;
                }
            } else {
                prtw("WARNING: What is this? [$line]\n");
            }
        } 
    }
    prt("Done $i lines...\n");
    ${$rh}{'CURR_INCLUDES:'.$ff} = \%incs;
    ${$rh}{'CURR_DEFINES:'.$ff} = \%defines;
    ${$rh}{'CURR_MAC_DEFS:'.$ff} = \%mac_defs;
}

sub process_all_lines($) {
    my ($rh) = @_;
    my $rala = ${$rh}{'CURR_ALL_LINES'};
    ${$rh}{'CURR_LINES'} = $rala;
    ${$rh}{'CURR_FILE'} = 'CURR_ALL_FILES';
    process_curr_lines($rh);
    show_includes($rh) if ($dbg_03 || VERB9());
}


sub process_ref_hash($) {
    my ($rh) = @_;
    my $rsa = ${$rh}{'SOURCES'};
    my $rha = ${$rh}{'HEADERS'};
    my ($ff);
    my %h = ();
    ${$rh}{'CURR_FILE_HASH'} = \%h;
    foreach $ff (@{$rha}) {
        ${$rh}{'CURR_FILE'} = $ff;
        process_source($rh);
    }
    foreach $ff (@{$rsa}) {
        ${$rh}{'CURR_FILE'} = $ff;
        process_source($rh);
    }
    my ($key,$val,$cnt);
    my @allines = ();
    foreach $key (keys %h) {
        $val = $h{$key};
        $cnt = scalar @{$val};
        prt("$key - $cnt lines\n") if ($dbg_05);
        push(@allines, @{$val});
    }
    ${$rh}{'CURR_ALL_LINES'} = \@allines;
    $cnt = scalar @allines;
    prt("Total $cnt lines...\n");
    write2file(join("\n",@allines)."\n",$tmp_out);
    prt("Written to [$tmp_out]\n");
    ### process_all_lines($rh);
}

sub show_qt_missed() {
    my @missed = sort keys(%g_qtmissed);
    my $cnt = scalar @missed;
    if ($cnt) {
        prt("Missing $cnt 'Q' classes...\n");
        my ($item);
        foreach $item (@missed) {
            prt("   '$item' => 0,\n");
        }
    }
}

#########################################
### MAIN ###
parse_args(@ARGV);
my $ref_hash = process_in_file($in_file);
process_ref_hash($ref_hash);
show_qt_missed();
pgm_exit(0,"");
########################################
sub give_help {
    prt("$pgmname: version $VERS\n");
    prt("Usage: $pgmname [options] in-file\n");
    prt("Options:\n");
    prt(" --help  (-h or -?) = This help, and exit 0.\n");
    prt(" --verb[n]     (-v) = Bump [or set] verbosity. def=$verbosity\n");
    prt(" --load        (-l) = Load LOG at end. ($outfile)\n");
    prt(" --out <file>  (-o) = Write output to this file.\n");
}

sub need_arg {
    my ($arg,@av) = @_;
    pgm_exit(1,"ERROR: [$arg] must have a following 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 =~ /^v/) {
                if ($sarg =~ /^v.*(\d+)$/) {
                    $verbosity = $1;
                } else {
                    while ($sarg =~ /^v/) {
                        $verbosity++;
                        $sarg = substr($sarg,1);
                    }
                }
                prt("Verbosity = $verbosity\n") if (VERB1());
            } elsif ($sarg =~ /^l/) {
                $load_log = 1;
                prt("Set to load log at end.\n") if (VERB1());
            } elsif ($sarg =~ /^o/) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $out_xml = $sarg;
                prt("Set out file to [$out_xml].\n") if (VERB1());
            } 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_file;
        $load_log = 1;
    }
    if (length($in_file) ==  0) {
        pgm_exit(1,"ERROR: No input files found in command!\n");
    }
    if (! -f $in_file) {
        pgm_exit(1,"ERROR: Unable to find in file [$in_file]! Check name, location...\n");
    }
}

# eof - template.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional