source: trunk/GDEHELP/warn_missing_itemhelp.pl

Last change on this file was 18831, checked in by westram, 4 years ago
  • improve GDE-menu robustness
    • warn if 'item' lacks an 'itemhelp' entry.
    • fail if 'itemhelp' lacks .hlp name.
    • bail out if 'item' contains duplicated 'itemhelp' or 'itemmeta' (menu parser)
  • currently results in the following warnings:
    MENUS/import.menu:15: Warning: item 'Import fields from calc-sheet' lacks an 'itemhelp' entry!
    MENUS/align.menu:1: Warning: item 'ProbCons' lacks an 'itemhelp' entry!
    MENUS/align.menu:50: Warning: item 'Muscle' lacks an 'itemhelp' entry!
    MENUS/phyml_20130708.menu:24: Warning: item 'PHYML-20130708 (DNA)' lacks an 'itemhelp' entry!
    MENUS/raxml.menu:18: Warning: item 'RAxML 7 (DNA)' lacks an 'itemhelp' entry!
    MENUS/start_arb.menu:1: Warning: item 'Start a slave ARB on a foreign host ...' lacks an 'itemhelp' entry!
    

Edit: fixed by [18863:18865]

  • Property svn:executable set to *
File size: 1.3 KB
Line 
1#!/usr/bin/perl
2#
3# Search for missing 'itemhelp' entries in menus
4
5use strict;
6use warnings;
7
8sub trim($) {
9  my ($str) = @_;
10  $str =~ s/^[\s]+//go;
11  $str =~ s/[\s]+$//go;
12  return $str;
13}
14
15my $lastitem      = undef;
16my $lastitem_loc  = undef;
17my $lastitem_name = undef;
18
19foreach my $line (<>) {
20  chomp($line);
21  if ($line =~ /^([^:]+:[0-9]+):/o) {
22    my ($loc,$rest) = ($1,$');
23    eval {
24      if ($rest =~ /[ ]*(item|itemhelp):/io) {
25        my ($tag,$content) = (lc($1), trim($'));
26        if ($tag eq 'item') {
27          if (defined $lastitem) {
28            print STDERR "$lastitem_loc: Warning: item '$lastitem_name' lacks an 'itemhelp' entry!\n";
29          }
30          $lastitem      = $line;
31          $lastitem_loc  = $loc;
32          $lastitem_name = $content;
33        }
34        elsif ($tag eq 'itemhelp') {
35          if (not defined $lastitem) {
36            die "detected 'itemhelp' w/o preceeding 'item'\n ";
37          }
38          $lastitem = undef;
39          if ($content eq '') {
40            die "itemhelp lacks name of helpfile\n ";
41          }
42        }
43        else { die "Unexpected tag '$tag'\n "; }
44      }
45      else {
46        die "expected 'item' or 'itemhelp' (grep failure?)\n ";
47      }
48    };
49    if ($@) {
50      die "$loc: Error: $@";
51    }
52  }
53  else {
54    die "Error: Unexpected line: '$line'\n ";
55  }
56}
Note: See TracBrowser for help on using the repository browser.