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