line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#============================================================= -*-perl-*- |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# XML::Schema::Handler::Simple.pm |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# DESCRIPTION |
6
|
|
|
|
|
|
|
# Module implementing a parser handler for simple content. |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
# AUTHOR |
9
|
|
|
|
|
|
|
# Andy Wardley |
10
|
|
|
|
|
|
|
# |
11
|
|
|
|
|
|
|
# COPYRIGHT |
12
|
|
|
|
|
|
|
# Copyright (C) 2001 Canon Research Centre Europe Ltd. |
13
|
|
|
|
|
|
|
# All Rights Reserved. |
14
|
|
|
|
|
|
|
# |
15
|
|
|
|
|
|
|
# This module is free software; you can redistribute it and/or |
16
|
|
|
|
|
|
|
# modify it under the same terms as Perl itself. |
17
|
|
|
|
|
|
|
# |
18
|
|
|
|
|
|
|
# REVISION |
19
|
|
|
|
|
|
|
# $Id: Simple.pm,v 1.1.1.1 2001/08/29 14:30:17 abw Exp $ |
20
|
|
|
|
|
|
|
# |
21
|
|
|
|
|
|
|
#======================================================================== |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
package XML::Schema::Handler::Simple; |
24
|
|
|
|
|
|
|
|
25
|
1
|
|
|
1
|
|
624
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
41
|
|
26
|
1
|
|
|
1
|
|
439
|
use XML::Schema::Handler; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
30
|
|
27
|
1
|
|
|
1
|
|
6
|
use base qw( XML::Schema::Handler ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
80
|
|
28
|
1
|
|
|
1
|
|
6
|
use vars qw( $VERSION $DEBUG $ERROR @SCHEDULES @MANDATORY ); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
701
|
|
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
$VERSION = sprintf("%d.%02d", q$Revision: 1.1.1.1 $ =~ /(\d+)\.(\d+)/); |
31
|
|
|
|
|
|
|
$DEBUG = 0 unless defined $DEBUG; |
32
|
|
|
|
|
|
|
$ERROR = ''; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
@MANDATORY = qw( type ); |
35
|
|
|
|
|
|
|
@SCHEDULES = qw( instance ); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
#------------------------------------------------------------------------ |
39
|
|
|
|
|
|
|
# start_element($instance, $name, \%attr) |
40
|
|
|
|
|
|
|
# |
41
|
|
|
|
|
|
|
# Called at start tag. |
42
|
|
|
|
|
|
|
#------------------------------------------------------------------------ |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
sub start_element { |
45
|
4
|
|
|
4
|
0
|
8
|
my ($self, $instance, $name, $attr) = @_; |
46
|
|
|
|
|
|
|
|
47
|
4
|
50
|
|
|
|
10
|
$self->TRACE("<$name>") if $DEBUG; |
48
|
|
|
|
|
|
|
|
49
|
4
|
|
|
|
|
7
|
$self->{ instance } = $instance; |
50
|
4
|
|
|
|
|
6
|
$self->{ name } = $name; |
51
|
4
|
|
|
|
|
8
|
$self->{ text } = ''; |
52
|
|
|
|
|
|
|
|
53
|
4
|
100
|
66
|
|
|
27
|
return $self->error("simple element type cannot contain attributes") |
54
|
|
|
|
|
|
|
if $attr && %$attr; |
55
|
|
|
|
|
|
|
|
56
|
3
|
|
|
|
|
13
|
return 1; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
#------------------------------------------------------------------------ |
61
|
|
|
|
|
|
|
# start_child($instance, $name, $attr) |
62
|
|
|
|
|
|
|
# |
63
|
|
|
|
|
|
|
# Should not be called: simple content can have no elements. |
64
|
|
|
|
|
|
|
#------------------------------------------------------------------------ |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
sub start_child { |
67
|
1
|
|
|
1
|
0
|
4
|
my ($self, $instance, $name, $attr) = @_; |
68
|
1
|
50
|
|
|
|
4
|
$self->TRACE("<$self->{ name }> <$name>") if $DEBUG; |
69
|
1
|
|
|
|
|
3
|
$self->error("simple element type cannot contain child elements"); |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
#------------------------------------------------------------------------ |
74
|
|
|
|
|
|
|
# end_child($instance, $name, $child) |
75
|
|
|
|
|
|
|
# |
76
|
|
|
|
|
|
|
# Should not be called: as above. |
77
|
|
|
|
|
|
|
#------------------------------------------------------------------------ |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
sub end_child { |
80
|
0
|
|
|
0
|
0
|
0
|
my ($self, $instance, $name) = @_; |
81
|
0
|
0
|
|
|
|
0
|
$self->TRACE("<$self->{ name }> $name>") if $DEBUG; |
82
|
0
|
|
|
|
|
0
|
$self->error("simple element type cannot contain child elements"); |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
#------------------------------------------------------------------------ |
87
|
|
|
|
|
|
|
# text($instance, $text) |
88
|
|
|
|
|
|
|
# |
89
|
|
|
|
|
|
|
# Called to store character content. |
90
|
|
|
|
|
|
|
#------------------------------------------------------------------------ |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub text { |
93
|
3
|
|
|
3
|
0
|
6
|
my ($self, $instance, $text) = @_; |
94
|
3
|
50
|
|
|
|
7
|
$self->TRACE("text => ", $self->_text_snippet($text)) if $DEBUG; |
95
|
3
|
|
|
|
|
7
|
$self->{ text } .= $text; |
96
|
3
|
|
|
|
|
13
|
return 1; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
#------------------------------------------------------------------------ |
101
|
|
|
|
|
|
|
# end_element($instance, $name) |
102
|
|
|
|
|
|
|
# |
103
|
|
|
|
|
|
|
# Called at end tag. Instantiates and returns a simple type instance. |
104
|
|
|
|
|
|
|
#------------------------------------------------------------------------ |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
sub end_element { |
107
|
3
|
|
|
3
|
0
|
6
|
my ($self, $instance, $name) = @_; |
108
|
|
|
|
|
|
|
|
109
|
3
|
50
|
|
|
|
7
|
$self->TRACE("instance => $instance, name => $name") if $DEBUG; |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
$self->throw($self->ID . " caught end of '$name' (expected $self->{ name })") |
112
|
3
|
50
|
|
|
|
9
|
unless $name eq $self->{ name }; |
113
|
|
|
|
|
|
|
|
114
|
3
|
|
|
|
|
6
|
my $type = $self->{ type }; |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
# copy 'text' to 'value' for validation to assert |
117
|
3
|
|
|
|
|
15
|
$self->{ value } = $self->{ text }; |
118
|
|
|
|
|
|
|
|
119
|
3
|
100
|
|
|
|
18
|
$type->validate_instance($self) |
120
|
|
|
|
|
|
|
|| return $self->error($type->error()); |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
# copy 'value' to 'result' for scheduled actions to modify |
123
|
2
|
|
|
|
|
6
|
$self->{ result } = $self->{ value }; |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
# activate any type specific actions |
126
|
2
|
50
|
|
|
|
8
|
$type->activate_instance($self) |
127
|
|
|
|
|
|
|
|| return $self->error($type->error()); |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
# activate handler specific actions |
130
|
2
|
|
|
|
|
9
|
$self->activate_instance($self); |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
sub ID { |
135
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
136
|
0
|
|
|
|
|
|
return "Simple_Handler[$self->{ name }]"; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
1; |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
__END__ |