File: sgml-catalog-check.pl

package info (click to toggle)
sgml-data 2.0.11%2Bnmu1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, sid
  • size: 1,700 kB
  • sloc: xml: 1,377; perl: 115; makefile: 49; sh: 16
file content (167 lines) | stat: -rwxr-xr-x 4,333 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
#!/usr/bin/perl
# sgml-catalog-check.pl -- check sgml catalog file
#
#Author: apharris@onshore.com (A. P. Harris)
#$Date: 2004/01/11 05:53:25 $
#$Revision: 1.20 $
#
#Todo:
#	cross check the links/dtds and make sure they all appear in the
#	  SGML catalog
#	convert to use perl sgml stuff instead of hand-rolling?
#	make a nice lintian script from this
#	deal with declation and notation files

use Getopt::Long;

$Verbose = 1;			# verboseness, 1 == chatty, 2 == loud
$SGMLdir = "debian/tmp/usr/share/sgml"; # default dir for link making etc
$Catalog = "sgml.catalog";	# default SGML catalog file
$ChopEN = 1;			# whether to chop off //EN[//.*] language specifiers

$Usage = "Usage: $0 [-d <SGML dir>] [-v #] [-e] [<SGML catalog file>]
Check SGML catalog file, create the links as documented in the SGML
sub-policy, and also ensure that the files referenced from the catalog
file actually exists.
   -d <SGML dir>        base dir, default is $SGMLdir
   -v <number>		verbosity amount, 0=silent, 1=default, 2=debug
   -e                   don't omit the trailing EN language specifier (//EN)
   -l                   legacy argument, ignored
   <SGML catalog file>  default is $Catalog
";

$warnings = $errors = 0;	# error and warning count

&GetOptions('e', 'h', 'l', 'v=i', 'd=s');

if ( $opt_h ) 
{
    print $Usage;
    $opt_h && exit;		# shut up -w
}
elsif ( $opt_d == 1 ) {
    die "option '-d' must have an argument\n$Usage";
} 
elsif ( $opt_d ) {
    $SGMLdir = $opt_d;
}

if ( defined($opt_v) ) {
    $Verbose = $opt_v;
}

if ( $opt_l ) {
    $opt_l = $opt_l;            # shut up, -w
    warn("symlinks under /usr/share/sgml no longer desired or created, ignoring -l\n");
}

if ( $opt_e ) {
    $opt_e = $opt_e;            # shut up, -w
    $ChopEN = 0;
}

if ( $#ARGV > 0 ) {
    die "too many arguments\n$Usage";
} elsif ( $#ARGV == 0 ) {
    $Catalog = $ARGV[0];
}

( -f $Catalog ) or
    die "catalog file $Catalog does not exist\n$Usage";
( -d $SGMLdir ) or
    die "SGML directory $SGMLdir does not exist\n$Usage";

open(CAT, "<$Catalog") or
    die "cannot read $Catalog: $!\n";

## when checking for system ids, we need to check relative to the
## catalog file location, so figure out the relative dir of the
## catalog file, possibly removing a prepended SGMLdir

$CatDir = `dirname $Catalog`;
chomp($CatDir);
$CatDir =~ s/^$SGMLdir\/?//;

while (<CAT>) {
    chomp;
    # FIXME: add another line if next line starts with whitespace
    # D: skipped catalog line:
    #  PUBLIC "-//OASIS//DTD DocBook V4.2//EN"
    # D: skipped catalog line:
    #    "docbook.dtd"

    if ( m/^PUBLIC\s+\"([^\"]+)\"\s+\"?([^\s\"]+)\"?/ ) {
	( $id, $file ) = ( $1, $2 );
	debug("found public identifier \"$id\"");
	debug("system identifier is $file");
	if ( -f "$SGMLdir/$CatDir/$file" ) {
            $file = "$CatDir/$file";
        } elsif ( ! -f "$SGMLdir/$file" ) {
	    error("referenced-file-does-not-exist $SGMLdir/$CatDir/$file of $SGMLdir/$file");
	    next;
	}
	
	if ( $id =~ m!^(.+)//(?:([^/]+)//)?(ELEMENTS|DOCUMENT|ENTITIES|DTD)\s+([^/]+)//(.+)$! ) {
	    ( $reg, $vendor, $type, $name, $misc ) = ( $1, $2, $3, $4, $5 );

	    if ( $type eq "ENTITIES" ) {
                                # AOK, no checking for location
	    } 
	    elsif ( $type eq "DTD" || $type eq "ELEMENTS" ) {
                                # AOK, no checking for location
	    }
	    elsif ( $type eq "DOCUMENT" ) {
		( $file =~ m!^dtd/! || $file =~ m!^entities! ) &&
		    error("DOCUMENT-in-dtd-or-entities-dir $file");
	    }
	    else {
		error("identifier-type-not-recognized $type on FPI $id");
	    }
	    
	    # would be nice to check that the DTD file is reasonable
	    # oh well...

            # quieten warnings
            $name = $name;
            $misc = $misc;
            $reg = $reg;
            $vendor = $vendor;
	}
	else {
	    error("SGML-identifier-not-in-recognized-form $id");
	    next;
	}
    }
    else {
	debug("skipped catalog line:\n   $_");
	next;
    }
}

if ( $errors ) {
    exit(1);
}
exit(0);

sub debug {
    local($msg) = @_;
    ( $Verbose > 1 ) && warn("D: $msg\n");
}

sub inform {
    local($msg) = @_;
    ( $Verbose ) && warn("N: $msg\n");
}

sub warning {
    local($msg) = @_;
    $warnings++;
    warn("W: $msg\n");
}

sub error {
    local($msg) = @_;
    $errors++;
    warn("E: $msg\n");
}