source: tags/ms_r16q3/SOURCE_TOOLS/check_resources.pl

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