source: branches/properties/SOURCE_TOOLS/check_resources.pl

Last change on this file was 18781, checked in by westram, 3 years ago
  • Property svn:executable set to *
File size: 21.9 KB
Line 
1#!/usr/bin/perl
2
3use strict;
4use warnings;
5# use diagnostics;
6
7# my $debug_verboose;
8
9# BEGIN {
10  # $debug_verboose = 1;
11  # $SIG{__DIE__} = sub {
12    # require Carp;
13    # if ($debug_verboose>0) { Carp::confess(@_); } # with backtrace
14    # else { Carp::croak(@_); }
15  # }
16# }
17
18
19# --------------------------------------------------------------------------------
20
21my $ARBHOME = $ENV{ARBHOME};
22if (not defined $ARBHOME) { die "Environmentvariable ARBHOME has be defined"; }
23if (not -d $ARBHOME) { die "ARBHOME ('$ARBHOME') does not point to a valid directory"; }
24
25# --------------------------------------------------------------------------------
26
27my @pictures  = (); # contains all .fig
28my @pixmaps   = (); # contains all .xpm
29my @helpfiles = (); # contains all .hlp, .pdf, .pdf.gz, .ps, .ps.gz
30
31my %known   = (); # contains all files contained in arrays above
32my %unknown = (); # contains all other files found in scanned directories
33
34my %picture  = (); # key=subdir/name (as used in code), value=index into @pictures
35my %pixmap   = (); # key=subdir/name (as used in code), value=index into @pixmaps
36my %helpfile = (); # key=subdir/name (as used in code), value=index into @helpfiles
37
38my %used = (); # key=file, value=1 -> used in code, value=2 -> used in helpfile
39
40my %full2rel = (); # key=full resource, value=relative resource (w/o rootdir)
41my %rel2full = (); # opposite
42
43# --------------------------------------------------------------------------------
44
45sub scanFiles(\@$$$$);
46sub scanFiles(\@$$$$) {
47  my ($files_r,$dir,$mask,$recurse,$ignoreLinks) = @_;
48
49  my $reg = qr/$mask/;
50
51  my @subdirs = ();
52  opendir(DIR,$dir) || die "can't read directory '$dir' (Reason: $!)";
53  foreach (readdir(DIR)) {
54    if ($_ ne '.' and $_ ne '..') {
55      my $full = $dir.'/'.$_;
56      if (-d $full) {
57        if (/unused/o) {
58          print "Ignoring resource directory '$full' (assuming it contains unused things)\n";
59        }
60        elsif (not (/^\.(svn|git)$/o or/^CVS$/o)) {
61          push @subdirs, $full;
62        }
63      }
64      else {
65        if ($ignoreLinks==0 || not -l $full) {
66          if ($_ =~ $reg) {
67            push @$files_r, $full;
68            $known{$full} = 1;
69            if (defined $unknown{$full}) { delete $unknown{$full}; }
70          }
71          elsif (/^Makefile$/o or /\.pl$/o) {
72            ; # ignore
73          }
74          elsif (not defined $known{$full}) {
75            $unknown{$full} = 1;
76          }
77        }
78      }
79    }
80  }
81  closedir(DIR);
82
83  if ($recurse==1) {
84    foreach (@subdirs) {
85      scanFiles(@$files_r, $_, $mask, $recurse, $ignoreLinks);
86    }
87  }
88}
89
90sub scanFilesAndIndex(\%\@$$$$) {
91  my ($index_r,$files_r,$dir,$mask,$recurse,$ignoreLinks) = @_;
92  my $prev_count = scalar(@$files_r);
93  scanFiles(@$files_r,$dir,$mask,$recurse,$ignoreLinks);
94
95  my $len   = length($dir)+1; # plus '/'
96  my $count = scalar(@$files_r);
97  for (my $c=$prev_count; $c<$count; $c++) {
98    my $rel = substr($$files_r[$c], $len);
99    $$index_r{$rel} = $c;
100    # print "full='".$$files_r[$c]."' idx='$c' rel='$rel'\n";
101  }
102}
103
104sub scanExistingRessources() {
105  scanFilesAndIndex(%picture,  @pictures,  $ARBHOME.'/lib/pictures',        '.*\.(fig|vfont)$',                 1, 0);
106  scanFilesAndIndex(%pixmap,   @pixmaps,   $ARBHOME.'/lib/pixmaps',         '.*\.(xpm|png)$',                   1, 0);
107  scanFilesAndIndex(%helpfile, @helpfiles, $ARBHOME.'/HELP_SOURCE/source',  '.*\.(hlp|ps|pdf|ps\.gz|pdf\.gz)$', 1, 0);
108  scanFilesAndIndex(%helpfile, @helpfiles, $ARBHOME.'/HELP_SOURCE/genhelp', '.*\.(hlp|ps|pdf|ps\.gz|pdf\.gz)$', 1, 0);
109
110  foreach (sort keys %unknown) {
111    if (/readme[^\/]*$/i)                    { ; } # ignore readme files
112    elsif (/\/genhelp\/.*(footer|header)$/o) { ; } # ignore files used for help generation
113    elsif (/\.bak$/o)                        { ; } # ignore bak files
114    elsif (/\.svg$/o)                        { ; } # ignore svg files (used as source to create png)
115    elsif (/\.gitignore$/o)                  { ; } # ignore .gitignore
116    else {
117        print "$_:0: Unhandled file in resource directory\n";
118    }
119  }
120
121  foreach (keys %picture)  { my $full = $pictures [$picture{$_}];  $full2rel{$full} = $_; }
122  foreach (keys %pixmap)   { my $full = $pixmaps  [$pixmap{$_}];   $full2rel{$full} = $_; }
123  foreach (keys %helpfile) { my $full = $helpfiles[$helpfile{$_}]; $full2rel{$full} = $_; }
124
125  foreach (keys %full2rel) {
126    my $rel = $full2rel{$_};
127    die if not defined $rel;
128    if (exists $rel2full{$rel}) {
129      print "$_:0: Error: resource name clashes with ...\n";
130      print $rel2full{$rel}.":0: ... this one\n";
131    }
132    else {
133      $rel2full{$rel} = $_;
134    }
135  }
136}
137
138sub dump_resource_list() {
139  print "List of resources (full->rel):\n";
140  foreach (sort keys %full2rel) { print $_.' -> '.$full2rel{$_}."\n"; }
141  print "List of resources (rel->full):\n";
142  foreach (sort keys %rel2full) { print $_.' -> '.$rel2full{$_}."\n"; }
143}
144
145# --------------------------------------------------------------------------------
146
147my $reg_parser = qr/([\(\),\\\"\'\;\{]|\/\*|\/\/)/;
148my $reg_parse_dquotes = qr/(\\.|\")/;
149my $reg_parse_squotes = qr/(\\.|\')/;
150my $reg_parse_eoc = qr/\*\//;
151
152sub scanNextToken(\$\@\$);
153sub scanNextToken(\$\@\$) {
154  my ($rest_r,$file_r,$lineNr_r) = @_;
155  # scans for the next token (tokens are '(', ')', ',', ';' and '{')
156  # and returns it together with it's prefix
157  # modifies rest_r and lineNr_r
158  # if no token is found until EOF, token will be 'undef'
159  # reads over comments
160
161  my $prefix = '';
162  my $match = undef;
163  if ($$rest_r =~ $reg_parser) {
164    my ($preTok,$tok) = ($`,$&);
165    $$rest_r = $';
166
167    if ($tok eq '(' or $tok eq ')' or $tok eq ',' or $tok eq ';' or $tok eq '{') { # accept wanted tokens
168      $prefix .= $preTok;
169      $match = $tok;
170    }
171    elsif ($tok eq '\\') { # skip escaped chars
172      $prefix .= $preTok.$tok.substr($$rest_r,0,1);
173      $$rest_r = substr($$rest_r,1);
174    }
175    elsif ($tok eq '/*') { # skip /**/-comments
176      $prefix .= $preTok;
177      # print "prefix='$prefix' preTok='$preTok' rest_r='$$rest_r'\n";
178      my $found = 0;
179      while ($found==0) {
180        if ($$rest_r =~ $reg_parse_eoc) {
181          # print "\$`='$`' \$&='$&' \$'='$''\n";
182          if (not $& eq '*/') { die "expected to see '*/', parsed '$&' from '$$rest_r' (this is a bug in check_resources.pl!)"; }
183          $$rest_r = $';
184          $found = 1;
185        }
186        else {
187          $$rest_r = $$file_r[$$lineNr_r++];
188          chomp($$rest_r);
189          # print "Continue in next line (while searching '*/'): '$$rest_r'\n";
190          if (not defined $$rest_r) { die "Unclosed '/*'"; }
191        }
192      }
193    }
194    elsif ($tok eq '//') {
195      $prefix .= $preTok;
196      $$rest_r = $$file_r[$$lineNr_r++];
197      chomp($$rest_r);
198      # print "Continue in next line (skipping '//'): '$$rest_r'\n";
199    }
200    elsif ($tok eq '"') {
201      $prefix .= $preTok.$tok;
202      my $closed_dquote = 0;
203      while ($closed_dquote==0) {
204        if ($$rest_r =~ $reg_parse_dquotes) {
205          $prefix .= $`.$&;
206          $$rest_r = $';
207          if ($& eq '"') { $closed_dquote = 1; }
208        }
209        else { die "Missing '\"'"; }
210      }
211    }
212    elsif ($tok eq '\'') {
213      $prefix .= $preTok.$tok;
214      my $closed_squote = 0;
215      while ($closed_squote==0) {
216        if ($$rest_r =~ $reg_parse_squotes) {
217          $prefix .= $`.$&;
218          $$rest_r = $';
219          if ($& eq '\'') { $closed_squote = 1; }
220        }
221        else { die "Missing '\''"; }
222      }
223    }
224    else {
225      die "Unknown token '$tok'";
226    }
227
228    if (not defined $match) { # continue
229      my $nextPrefix;
230      ($nextPrefix,$match) = scanNextToken($$rest_r, @$file_r, $$lineNr_r);
231      $prefix .= $nextPrefix;
232    }
233  }
234  else {
235    $prefix .= $$rest_r;
236    $$rest_r = $$file_r[$$lineNr_r++];
237    chomp($$rest_r);
238    # print "Continue in next line: '$$rest_r'\n";
239    if (defined $$rest_r) { # not EOF yet
240      my $p;
241      ($p,$match) = scanNextToken($$rest_r,@$file_r,$$lineNr_r);
242      $prefix .= $p;
243    }
244  }
245
246  return ($prefix,$match);
247}
248
249sub scanParams($\@$\$) {
250  my ($rest,$file_r,$lineNr,$calltype_r) = @_;
251
252  $$calltype_r = 0; # no params
253
254  my ($prefix,$token);
255  my @params = ();
256  eval {
257    ($prefix,$token) = scanNextToken($rest,@$file_r,$lineNr);
258  };
259  if (!$@ and $token eq '(') {
260    if (trim($prefix) ne '') {
261      # print "Found prefix '$prefix' before potential parameter list - assume it's sth else\n";
262    }
263    else {
264      my $openParens = 1;
265      my $prevPrefix = '';
266      while ($openParens>0) {
267        ($prefix,$token) = scanNextToken($rest,@$file_r,$lineNr);
268        my $seen_eop = 0;
269
270        if (not defined $token) { die "EOF reached while scanning parameter list"; }
271        elsif ($token eq ')') { $openParens--; if ($openParens==0) { $seen_eop = 1; } }
272        elsif ($token eq '(') { $openParens++; }
273        elsif ($token eq ',') { if ($openParens==1) { $seen_eop = 1; } }
274        else { die "Unexpected token '$token' (behind '$prefix')"; }
275
276        $prevPrefix .= $prefix;
277        if ($seen_eop==1) { push @params, $prevPrefix; $prevPrefix = ''; }
278        else { $prevPrefix .= $token; }
279      }
280
281      $$calltype_r = 1;
282      eval {
283        ($prefix,$token) = scanNextToken($rest,@$file_r,$lineNr);
284      };
285      if ($@) {
286        @params = ();
287      }
288      else {
289        if    ($token eq ';') { $$calltype_r = 2; } # accepted call
290        elsif ($token eq '{') { $$calltype_r = 3; } # function def
291        elsif ($token eq ')') { $$calltype_r = 2; } # accepted ("othercall(call())")
292        elsif ($token eq ',') { $$calltype_r = 2; } # accepted ("othercall(call(),...)")
293        else {
294          if ($prefix =~ /__ATTR_/o) {
295            $$calltype_r = 3; # function def
296          }
297          else {
298            die "unknown token behind call: '$token' (possible call; ignored due to this error; prefix='$prefix')\n";
299          }
300        }
301      }
302    }
303  }
304
305  return @params;
306}
307
308sub trim($) {
309  my ($str) = @_;
310  $str =~ s/^\s+//g;
311  $str =~ s/\s+$//g;
312  return $str;
313}
314
315sub isQuoted($);
316sub isQuoted($) {
317  my ($str) = @_;
318  if ($str =~ /^\"(.*)\"$/o) { return $1; }
319  if ($str =~ /^\(\s*AW_CL\s*\)\s*/o) {
320    return isQuoted($');
321  }
322  if ($str =~ 'AW_POPUP_HELP') { return 'AW_POPUP_HELP'; }
323  return undef;
324}
325
326# --------------------------------------------------------------------------------
327
328sub acceptAll($) {
329  my ($res_param) = @_;
330  return ($res_param);
331}
332sub isPixmapRef($) {
333  my ($res_param) = @_;
334  if ($res_param =~ /^#/) { return ($'); }
335  return ();
336}
337sub isIconRes($) {
338  my ($res_param) = @_;
339  my $base = 'icons/'.$res_param;
340  return ($base.'.xpm', $base.'.png');
341}
342sub isHelpRef($) {
343  my ($res_param) = @_;
344  if ($res_param =~ /\.(hlp|ps|pdf)$/o) { return ($res_param); }
345  return ();
346}
347
348my @defs =
349  (
350   # regexp for function,                  param numbers,         expectInIndex, isRessource,
351   [ qr/\b(AW_help_popup)\b/,              [ 2 ],                 \%helpfile,    \&isHelpRef,     ],
352   [ qr/\b(create_button)\b/,              [ 2 ],                 \%pixmap,      \&isPixmapRef,   ],
353   [ qr/\b(create_mode)\b/,                [ 1 ],                 \%pixmap,      \&acceptAll,     ],
354   [ qr/\b(create_mode)\b/,                [ 2 ],                 \%helpfile,    \&isHelpRef,     ],
355   [ qr/\b(create_toggle)\b/,              [ -2, -3 ],            \%pixmap,      \&isPixmapRef,   ],
356   [ qr/\b(help_text)\b/,                  [ 1 ],                 \%helpfile,    \&isHelpRef,     ],
357   [ qr/\b(makeHelpCallback)\b/,           [ 1 ],                 \%helpfile,    \&isHelpRef,     ],
358   [ qr/\b(AWT_create_root)\b/,            [ 2 ],                 \%pixmap,      \&isIconRes,     ],
359   [ qr/\b(insert_help_topic)\b/,          [ 3 ],                 \%helpfile,    \&isHelpRef,     ],
360   [ qr/\b(insert_menu_topic)\b/,          [ 2 ],                 \%pixmap,      \&isPixmapRef,   ],
361   [ qr/\b(insert_menu_topic)\b/,          [ 4 ],                 \%helpfile,    \&isHelpRef,     ],
362   [ qr/\b(insert_mark_topic)\b/,          [ 7 ],                 \%helpfile,    \&isHelpRef,     ],
363   [ qr/\b(GEN_insert_extract_submenu)\b/, [ 6 ],                 \%helpfile,    \&isHelpRef,     ],
364   [ qr/\b(GEN_insert_mark_submenu)\b/,    [ 6 ],                 \%helpfile,    \&isHelpRef,     ],
365   [ qr/\b(AW_advice)\b/,                  [ -4 ],                \%helpfile,    \&isHelpRef,     ],
366   [ qr/\b(add_help)\b/,                   [ 1 ],                 \%helpfile,    \&isHelpRef,     ],
367   [ qr/\b(insert_toggle)\b/,              [ 1 ],                 \%pixmap,      \&isPixmapRef,   ],
368   [ qr/\b(load_xfig)\b/,                  [ 1 ],                 \%picture,     \&acceptAll,     ],
369
370   # pseudos (used in comment to mark a resource as used)
371   [ qr/\b(uses_hlp_res)\b/,               [ 1, -2, -3, -4, -5 ], \%helpfile, \&isHelpRef,     ],
372   # [ qr/\b(uses_pic_res)\b/,               [ 1, -2, -3, -4, -5 ], \%picture,  \&acceptAll,     ],
373   [ qr/\b(uses_pix_res)\b/,               [ 1, -2, -3, -4, -5 ], \%pixmap,   \&acceptAll,     ],
374  );
375
376# - param numbers is [1..n] or [-1..-n] for optional params
377# - isRessource gets the unquoted potential resource (without possible '(AW_CL)'-cast) and
378#   returns the plain resource name or undef (if it's definitely no resource)
379
380my $defs                = scalar(@defs);
381my $errors              = 0;
382my $LOC                 = 0;
383my $showSpecialWarnings = 0;
384my $abort_on_error      = 0;
385
386my @ruleMatched = ();
387
388sub scanCodeFile($) {
389  my ($file) = @_;
390  open(FILE,'<'.$file) || die "can't read '$file' (Reason: $!)";
391
392  my @file = <FILE>;
393  my $flines = scalar(@file);
394  unshift @file, undef; # line 0
395
396  my $lineNr = 0;
397  eval {
398    for ($lineNr=1; $lineNr<=$flines; $lineNr++) {
399      my $line = $file[$lineNr];
400      # if ($line =~ /kernlin/io) { print "$file:$lineNr: Custom-Search: ".trim($line)."\n"; } # used to test this script
401
402      for (my $d=0; $d<$defs; $d++) {
403        my $def_r = $defs[$d];
404        my $reg = $$def_r[0];
405        if ($line =~ $reg) {
406          my $rest = $';
407          my $match = $&;
408          # print "reg='$reg'\n";
409          # print "$file:$lineNr: Match def #$d: $line";
410
411          chomp($rest);
412          my $calltype;
413          my @params = scanParams($rest,@file,$lineNr+1,$calltype);
414
415          if ($calltype==2) {
416            my $pnum_r = $$def_r[1];
417            my $pis = scalar(@$pnum_r);
418            for (my $pi=0; $pi<$pis; $pi++) { # for all params referencing a resource
419              my $pnum = $$pnum_r[$pi];
420              my $param = $params[$pnum<0 ? -$pnum-1 : $pnum-1];
421
422              if (defined $param) {
423                $param = trim($param);
424                my $unquoted = isQuoted($param);
425                if (defined $unquoted) {
426                  my $test_r = $$def_r[3];
427                  my @unquoted = &$test_r($unquoted); # test if definitely NO resource
428
429                  if (scalar(@unquoted)>0) { # possible resource(s)
430                    my $idx_r = $$def_r[2]; # resource index
431                    my $used = 0;
432                  UNQUOTED: foreach my $unquoted (@unquoted) {
433                      my $full_resource_idx = $$idx_r{$unquoted};
434                      if (not defined $full_resource_idx and $unquoted =~ /\.(ps|pdf)$/o) {
435                        $unquoted .= '.gz';  # try zipped version
436                        $full_resource_idx = $$idx_r{$unquoted};
437                      }
438                      if (defined $full_resource_idx) { # existing resource
439                        my $full_resource = $rel2full{$unquoted};
440                        if (not defined $full_resource) {
441                          dump_resource_list();
442                          $abort_on_error = 1;
443                          die "expected resource '$unquoted' to be defined.\n ";
444                        }
445                        $used{$full_resource} = 1;
446                        $ruleMatched[$d] = 1;
447                        $used = 1;
448                      }
449                    }
450
451                    if ($used==0) {
452                      print "$file:$lineNr: Error: Ressource '".$unquoted[0]."' is missing\n";
453                      $errors++;
454                    }
455                  }
456                }
457                else {
458                  if ($showSpecialWarnings==1) {
459                    print "$file:$lineNr: Warning: Param '$param' is not an explicit resource, can't check\n";
460                    # print "Params:\n"; foreach (@params) { print "- param='$_'\n"; }
461                  }
462                }
463              }
464              else {
465                if ($pnum>0) {
466                  print "$file:$lineNr: Warning: Param #$pnum is missing, can't check (maybe param should be optional)\n";
467                }
468              }
469            }
470          }
471          else {
472            if ($showSpecialWarnings==1 and $calltype!=3) { # don't warn about function definition
473              print "$file:$lineNr: Warning: Matched '$match', but wrong calltype (=$calltype)\n";
474            }
475          }
476        }
477      }
478    }
479  };
480  if ($@) {
481    print "$file:$lineNr: Error: $@\n";
482    $errors++;
483    if ($abort_on_error==1) {
484      die "stop after first error requested";
485    }
486    # if ($@ =~ /enough/) { die "enough"; }
487  }
488  close(FILE);
489  $LOC += $flines;
490}
491
492sub autouse($) {
493  my ($res) = @_;
494  if (not defined $known{$res}) {
495    print "Warning: Invalid autouse($res) -- unknown resource\n";
496  }
497  else {
498    $used{$res} = 1;
499  }
500}
501
502sub scanCodeFile_forUnuseds($\$\%) {
503  my ($file,$reg_r,$seen_r) = @_;
504  open(FILE,'<'.$file) || die "can't read '$file' (Reason: $!)";
505
506  my @file = <FILE>;
507  my $flines = scalar(@file);
508  unshift @file, undef;         # line 0
509
510  my $lineNr = 0;
511  for ($lineNr=1; $lineNr<=$flines; $lineNr++) {
512    my $line = $file[$lineNr];
513    while ($line =~ $$reg_r) {
514      my $res = $&;
515      # print "$file:$lineNr: Warning: Checker failed to detect potential usage of resource '$res'\n";
516      my $seen = $$seen_r{$res};
517      if (defined $seen) { $seen .= ",$file:$lineNr"; }
518      else { $seen = "$file:$lineNr"; }
519      $$seen_r{$res} = $seen;
520      $line = $';
521    }
522  }
523  close(FILE);
524}
525
526my %helpScanned = ();
527my $newHelpRef  = 0;
528
529sub referenceHelp($);
530sub referenceHelp($) {
531  my ($referred) = @_;
532
533  my $full_resource_idx = $helpfile{$referred};
534  if (defined $full_resource_idx) { # existing resource
535    my $full_resource = $rel2full{$referred};
536    if (not defined $full_resource) { die "expected resource '$referred' to be defined"; }
537    $used{$full_resource} = 1;
538    $newHelpRef++;
539  }
540  else {
541    if ($referred =~ /\.(pdf|ps)$/) {
542      referenceHelp($referred.'.gz');
543    }
544    elsif ($referred =~ /\@/) {
545      ; # ignore mail addresses
546    }
547    elsif ($referred =~ /^(https?|file|ftp):\/\//o) {
548      ; # ignore urls
549    }
550    else {
551      die "Ressource '".$referred."' is missing\n";
552    }
553  }
554}
555
556sub scanHelpFile($) {
557  my ($file) = @_;
558  if ($file =~ /\.hlp$/o) {
559    if (defined $used{$file} and not defined $helpScanned{$file}) {
560      open(FILE,'<'.$file) || die "can't read '$file' (Reason: $!)";
561      my @file = <FILE>;
562      my $flines = scalar(@file);
563      unshift @file, undef;     # line 0
564      my $lineNr = 0;
565      for ($lineNr=1; $lineNr<=$flines; $lineNr++) {
566        eval {
567          $_ = $file[$lineNr];
568          if (/#/) { $_ = $`; }  # skip comments
569          if (/^\s*(SUB|UP)\s+(.*)$/o) {
570            referenceHelp($2);
571          }
572          else {
573            while (/LINK\{([^\}]*)\}/o) {
574              my $rest = $';
575              referenceHelp($1);
576              $_ = $rest;
577            }
578          }
579        };
580        if ($@) {
581          chomp($@);
582          print "$file:$lineNr: Error: $@\n";
583          $errors++;
584          # if ($@ =~ /enough/) { die "enough"; }
585        }
586      }
587      close(FILE);
588      $helpScanned{$file} = 1;
589      $LOC += $flines;
590    }
591  }
592}
593
594
595sub scanCode() {
596  my @sources = ();
597  {
598    my %oldKnown = %known;
599    scanFiles(@sources, $ARBHOME, '\.[ch](xx|pp){0,1}$', 1, 1); # destroys %known and %unknown
600    print 'Checking '.scalar(@sources)." source files.\n";
601
602    %known = %oldKnown;
603    %unknown = ();
604  }
605
606  for (my $d=0; $d<scalar(@defs); ++$d) { $ruleMatched[$d] = 0; }
607  @sources = sort @sources;
608  foreach (@sources) { scanCodeFile($_); }
609
610  {
611    my $intro = 0;
612    for (my $d=0; $d<scalar(@defs); ++$d) {
613      if ($ruleMatched[$d] == 0) {
614        if ($intro==0) { print "Some code-rules never applied:"; $intro = 1; }
615        print " \#$d";
616      }
617    }
618    if ($intro==1) { print "\n"; }
619  }
620
621  $newHelpRef = 1;
622  while ($newHelpRef>0) {
623    $newHelpRef = 0;
624    foreach (@helpfiles) { scanHelpFile($_); }
625  }
626
627  print "Scanned $LOC LOC.\n";
628
629  autouse($ARBHOME.'/HELP_SOURCE/source/unittest.hlp');
630
631  my %unused = ();
632  foreach (sort keys %known) {
633    if (not defined $used{$_}) { $unused{$_} = 1; }
634  }
635
636  my $unused = scalar(keys %unused);
637
638  if ($unused>0) {
639    print "Detected $unused unused resources.\nRunning brute force scan..\n";
640    my $reg_unused = '';
641    foreach (keys %unused) {
642      my $rel=$full2rel{$_};
643      if (defined $rel) {
644        $reg_unused .= '|'.quotemeta($rel);
645      }
646      else {
647        print "$_:0: Warning: possibly duplicate help in different dirs\n";
648      }
649    }
650    $reg_unused = substr($reg_unused,1);
651    print "reg_unused='$reg_unused'\n";
652    $reg_unused = qr/$reg_unused/;
653
654    my %seen_unused = ();
655    foreach (@sources) {
656      scanCodeFile_forUnuseds($_,$reg_unused, %seen_unused);
657    }
658
659    foreach (sort keys %unused) {
660      my $rel = $full2rel{$_};
661      my $seen = (defined $rel) ? $seen_unused{$rel} : undef;
662      if (defined $seen) {
663        print "$_:0: Warning: Checker failed to detect resource usage\n";
664        my @seen = split(',',$seen);
665        my %seen = map { $_ => 1; } @seen;
666        foreach (sort keys %seen) {
667          print "$_: Warning: '$rel' possibly used here\n";
668        }
669      }
670      else {
671        print "$_:0: Error: Ressource is most likely unused\n";
672        $errors++;
673      }
674    }
675  }
676  else {
677    print "All found resources are referenced from code :-)\n"
678  }
679}
680
681sub main() {
682  print "Checking ARB resources\n";
683
684  scanExistingRessources();
685  print ' - '.scalar(@pictures)." pictures\n";
686  print ' - '.scalar(@pixmaps)." images\n";
687  print ' - '.scalar(@helpfiles)." helpfiles\n";
688
689  scanCode();
690  if ($errors>0) { die "$errors errors detected by resource checker\n"; }
691}
692
693main();
Note: See TracBrowser for help on using the repository browser.