source: tags/ms_ra2q56/SOURCE_TOOLS/check_resources.pl

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