summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/PPM/XML/ValidatingElement.pm
blob: b9808a2d2b2d42d6334ea4b81ad055c8f800bd3b (plain)
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
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
package PPM::XML::ValidatingElement;
use PPM::XML::Element;
use vars qw( $VERSION @ISA );
$VERSION = '0.01_01';

###############################################################################
#
# PPM::XML::ValidatingElement
#
# Base class for validating elements.  Allows for applying DTD type
# restrictions to elements parsed using the XML::Parser module.
#
###############################################################################

###############################################################################
# Define the validating element class.
###############################################################################
@ISA = qw( PPM::XML::Element );

###############################################################################
# Recursively validate myself and all child elements with all four types of
# validation.  Returns non-zero on success and zero on any errors.
###############################################################################
sub rvalidate
{
    my $self = shift;
    my $func = shift;
    my $success = 1;

    $success &= $self->validate_possible_attrs( $func );
    $success &= $self->validate_required_attrs( $func );
    $success &= $self->validate_possible_kids( $func );
    $success &= $self->validate_required_kids( $func );

    foreach (@{$self->{Kids}})
    {
        if ((ref $_) !~ /::Characters$/o)
            { $success &= $_->rvalidate( $func ); }
    }

    return $success;
}

###############################################################################
# Validate the element with all four types of validation.  Returns non-zero on
# success any zero if any errors occurred.
###############################################################################
sub validate
{
    my $self = shift;
    my $func = shift;
    my $success = 1;

    $success &= $self->validate_possible_attrs( $func );
    $success &= $self->validate_required_attrs( $func );
    $success &= $self->validate_possible_kids( $func );
    $success &= $self->validate_required_kids( $func );

    return $success;
}

###############################################################################
# Validate possible attributes.  Returns non-zero on sucess, and zero if any
# errors occurred.
###############################################################################
sub validate_possible_attrs
{
    my $self = shift;
    my $func = shift;
    my $attr;
    my $type = ref $self;
    my $success = 1;

    my $elem = $type;
    $elem =~ s/.*:://;

    my @allattrs;
    push( @allattrs, @{"$type\::oattrs"}, @{"$type\::rattrs"} );

    # Check our list of attributes against the list of possible attributes we
    # can have.
    foreach $attr (keys %{$self})
    {
        if ( ($attr ne 'Kids') and ($attr ne 'Text') )
        {
            if (!grep( /^$attr$/, @allattrs ))
            {
                &$func( "Element '$elem' doesn't allow the '$attr' attribute." );
                $success = 0;
            }
        }
    }

    return $success;
}

###############################################################################
# Validate required attributes.  Returns non-zero on success and zero if any
# errors occurred.
###############################################################################
sub validate_required_attrs
{
    my $self = shift;
    my $func = shift;
    my $attr;
    my $type = ref $self;
    my $success = 1;

    my $elem = $type;
    $elem =~ s/.*:://;

    # Check the list of required attributes against the list of attributes
    # which were parsed.
    foreach $attr (@{"$type\::rattrs"})
    {
        if (!grep( /^$attr$/, (keys %{$self}) ))
        {
            &$func( "Element '$elem' must have a '$attr' attribute." );
            $success = 0;
        }
    }

    return $success;
}

###############################################################################
# Validate possible child elements.  Returns non-zero on success and zero if
# any errors occurred.
###############################################################################
sub validate_possible_kids
{
    my $self = shift;
    my $func = shift;
    my $kid;
    my $type = ref $self;
    my $success = 1;
    
    my $elem = $type;
    $elem =~ s/.*:://;

    my $base = $type;
    $base =~ s/::[^:]*?$//;

    my @allkids;
    push( @allkids, @{"$type\::okids"}, @{"$type\::rkids"} );

    foreach $kid (@{ $self->{Kids} })
    {
        my $kid_type = ref $kid;
        $kid_type =~ s/.*:://;
        next if ($kid_type eq 'Characters');    # Don't validate character data

        if (!grep( /^$kid_type$/, @allkids ))
        {
            &$func( "Element '$elem' cannot contain a child element '$kid_type'" );
            $success = 0;
        }
    }

    return $success;
}

###############################################################################
# Validate required child elements.  Returns non-zero on success and zero if
# any errors occurred.
###############################################################################
sub validate_required_kids
{
    my $self = shift;
    my $func = shift;
    my $kid;
    my $type = ref $self;
    my $success = 1;

    my $elem = $type;
    $elem =~ s/.*:://;

    my $base = $type;
    $base =~ s/::[^:]*?$//;

    foreach $kid (@{"$type\::rkids"})
    {
        my @kidlist = map( ref, @{$self->{Kids}} );

        if (!grep( /^$base\::$kid$/, @kidlist ))
        {
            &$func( "Element '$elem' must contain a '$kid' element." );
            $success = 0;
        }
    }

    return $success;
}

__END__

###############################################################################
# POD
###############################################################################

=head1 NAME

PPM::XML::ValidatingElement - XML Element with DTD-like validation rules

=head1 SYNOPSIS

 use PPM::XML::ValidatingElement;

 package PPM::XML::MyElement;
 @ISA = qw( PPM::XML::ValidatingElement );
 @oattrs = qw( BAR );       # Allow for both FOO and BAR attributes
 @rattrs = qw( FOO );
 @okids  = qw( BLEARGH );   # Allow for both BLEARGH and FOOBAR children
 @rkids  = qw( FOOBAR );

=head1 DESCRIPTION

PPM::XML::ValidatingElement inherits from PPM::XML::Element.  It extends 
this class to support methods for validation to allow for DTD-like 
restrictions to be places on documents read in with the XML::Parser module.

=head1 VALIDATION RULES

In order to set up rules for validation of elements, each element should
define four list values in it's own package namespace.  When validating, this
module will check to ensure that any parsed attributes or child elements are
actually ones that are possible for this element, as well as checking to see
that any required attributes/child elements are present.

Note that an attribute/child element only has to be present in either the
optional or required list; when checking for possible attributes/children,
these lists will be combined.

Validation lists:

=over 4

=item @oattrs

List of optional attributes.

=item @rattrs

List of required attributes.

=item @opkids

List of optional child elements.

=item @rkids

List of required child elements.

=back

=head1 METHODS

=over 4

=item validate( err_handler )

Validates the current element.  This method calls four other methods to
validate all of requirements for the element.  Returns non-zero on success and
zero if any errors occurred.

=item rvalidate( err_handler )

Validates the current element, and recursively validates all child elements.
This method calls four other methods to validate all of the requirements for
the element.  Returns non-zero on success and zero if any errors occurred.

=item validate_possible_attrs( err_handler )

Checks against the list of attributes possible for this element (taken from
@oattr and @rattr) to ensure that all of the parsed attributes are valid.  If
any parsed attributes are not in the list of possible attributes for this
element, err_handler will be called with a message stating the error.  Returns
non-zero on success and zero if any errors occurred.

=item validate_required_attrs( err_handler )

Checks against the list of required attributes (taken from @rattr) to ensure
that all of the required attributes are present and have been parsed.  If any
required attributes are missing, err_handler will be called with a message
stating the error.  Returns non-zero on success and zero if any errors
occurred.

=item validate_possible_kids( err_handler )

Checks against the list of child elements this element can contain (taken from
@okids and @rkids) to ensure that any child elements that have been read in are
valid.  If any child elements have been parsed which are not in the list of
possible children, err_handler will be called with a message stating the
error.  Returns non-zero on success and zero if any errors occurred.

=item validate_required_kids( err_handler )

Checks against the lsit of required child elements (taken from @rkids) to
ensure that all of the required child elements are present and have been
parsed.  If any of the required child elements are missing, err_handler will be
called with a message stating the error.  Returns non-zero on success and zero
if any errors occurred.

=back

=head1 LIMITATIONS

The PPM::XML::ValidatingElement module only provides checks for determining
whether or not the possible/required attributes/children are present.  This 
module currently has no support for determining whether or not the values 
provided are actually valid (although I imagine it wouldn't be too hard to
add this in somewhere).  This also includes elements which have been declared
in a DTD as being 'EMPTY' elements.

=head1 AUTHORS

Graham TerMarsch <grahamt@activestate.com>

=head1 HISTORY

v0.2 - Added failure return values to each of the methods.

v0.1 - Initial version

=head1 SEE ALSO

L<PPM::XML::Element>,
L<XML::Parser>

=cut