1package XML::STX::Base;
2
3require 5.005_02;
4BEGIN { require warnings if $] >= 5.006; }
5use strict ('refs', 'subs');
6use vars qw(@EXPORT);
7use XML::STX::Writer;
8use XML::SAX::PurePerl;
9require Exporter;
10@XML::STX::Base::ISA = qw(Exporter);
11
12# --------------------------------------------------
13# common constants
14# --------------------------------------------------
15@EXPORT = qw( STX_ELEMENT_NODE
16	      STX_TEXT_NODE
17	      STX_CDATA_NODE
18	      STX_PI_NODE
19	      STX_COMMENT_NODE
20	      STX_ATTRIBUTE_NODE
21	      STX_ROOT_NODE
22
23              STX_NODE
24              STX_BOOLEAN
25              STX_NUMBER
26              STX_STRING
27
28	      STX_NS_URI
29	      STX_FNS_URI
30	      STX_VERSION
31	      XMLNS_URI
32
33              STXE_START_DOCUMENT
34	      STXE_END_DOCUMENT
35	      STXE_START_ELEMENT
36	      STXE_END_ELEMENT
37	      STXE_CHARACTERS
38	      STXE_PI
39	      STXE_START_CDATA
40	      STXE_END_CDATA
41	      STXE_COMMENT
42	      STXE_START_BUFFER
43	      STXE_END_BUFFER
44	      STXE_START_PREF
45	      STXE_END_PREF
46
47	      I_LITERAL_START
48	      I_LITERAL_END
49	      I_ELEMENT_START
50	      I_ELEMENT_END
51	      I_P_CHILDREN_START
52	      I_P_CHILDREN_END
53	      I_P_SIBLINGS_START
54	      I_P_SIBLINGS_END
55	      I_P_SELF_START
56	      I_P_SELF_END
57	      I_P_BUFFER_START
58	      I_P_BUFFER_END
59	      I_P_DOC_START
60	      I_P_DOC_END
61	      I_P_ATTRIBUTES_START
62	      I_P_ATTRIBUTES_END
63              I_CALL_PROCEDURE_START
64              I_CALL_PROCEDURE_END
65	      I_CHARACTERS
66	      I_COPY_START
67	      I_COPY_END
68              I_ATTRIBUTE_START
69	      I_ATTRIBUTE_END
70	      I_CDATA_START
71	      I_CDATA_END
72	      I_COMMENT_START
73	      I_COMMENT_END
74	      I_PI_START
75	      I_PI_END
76
77	      I_IF_START
78	      I_IF_END
79	      I_VARIABLE_START
80	      I_VARIABLE_END
81	      I_VARIABLE_SCOPE_END
82	      I_ASSIGN_START
83	      I_ASSIGN_END
84	      I_ELSE_START
85	      I_ELSE_END
86	      I_ELSIF_START
87	      I_ELSIF_END
88              I_BUFFER_START
89              I_BUFFER_END
90              I_BUFFER_SCOPE_END
91              I_RES_BUFFER_START
92              I_RES_BUFFER_END
93              I_RES_DOC_START
94              I_RES_DOC_END
95	      I_WITH_PARAM_START
96	      I_WITH_PARAM_END
97	      I_PARAMETER_START
98              I_FOR_EACH_ITEM
99              I_WHILE
100
101	      $NCName
102	      $QName
103	      $NCWild
104	      $QNWild
105	      $NODE_TYPE
106	      $NUMBER_RE
107	      $DOUBLE_RE
108	      $LITERAL
109              $URIREF
110	    );
111
112# node types
113sub STX_ELEMENT_NODE(){1;}
114sub STX_TEXT_NODE(){2;}
115sub STX_CDATA_NODE(){3;}
116sub STX_PI_NODE(){4;}
117sub STX_COMMENT_NODE(){5;}
118sub STX_ATTRIBUTE_NODE(){6;}
119sub STX_ROOT_NODE(){7;}
120
121# atomic data types
122sub STX_NODE(){1;}
123sub STX_BOOLEAN(){2;}
124sub STX_NUMBER() {3;}
125sub STX_STRING() {4;}
126
127# STX constants
128sub STX_NS_URI() {'http://stx.sourceforge.net/2002/ns'};
129sub STX_FNS_URI() {'http://stx.sourceforge.net/2003/functions'};
130sub STX_VERSION() {'1.0'};
131sub XMLNS_URI() {'http://www.w3.org/2000/xmlns/'};
132
133# events
134sub STXE_START_DOCUMENT(){1;}
135sub STXE_END_DOCUMENT(){2;}
136sub STXE_START_ELEMENT(){3;}
137sub STXE_END_ELEMENT(){4;}
138sub STXE_CHARACTERS(){5;}
139sub STXE_PI(){6;}
140sub STXE_START_CDATA(){7;}
141sub STXE_END_CDATA(){8;}
142sub STXE_COMMENT(){9;}
143sub STXE_START_BUFFER(){10;}
144sub STXE_END_BUFFER(){11;}
145sub STXE_START_PREF(){12;}
146sub STXE_END_PREF(){13;}
147
148# instructions
149sub I_LITERAL_START(){1;}
150sub I_LITERAL_END(){2;}
151sub I_ELEMENT_START(){3;}
152sub I_ELEMENT_END(){4;}
153sub I_P_CHILDREN_START(){5;}
154sub I_P_CHILDREN_END(){6;}
155sub I_CHARACTERS(){7;}
156sub I_COPY_START(){8;}
157sub I_COPY_END(){9;}
158sub I_ATTRIBUTE_START(){10;}
159sub I_ATTRIBUTE_END(){11;}
160sub I_CDATA_START(){12;}
161sub I_CDATA_END(){13;}
162sub I_COMMENT_START(){14;}
163sub I_COMMENT_END(){15;}
164sub I_PI_START(){16;}
165sub I_PI_END(){17;}
166sub I_P_SELF_START(){18;}
167sub I_P_SELF_END(){19;}
168sub I_P_ATTRIBUTES_START(){20;}
169sub I_P_ATTRIBUTES_END(){21;}
170sub I_CALL_PROCEDURE_START(){22;}
171sub I_CALL_PROCEDURE_END(){23;}
172sub I_P_BUFFER_START(){24;}
173sub I_P_BUFFER_END(){25;}
174sub I_P_DOC_START(){26;}
175sub I_P_DOC_END(){27;}
176sub I_P_SIBLINGS_START(){28;}
177sub I_P_SIBLINGS_END(){29;}
178
179sub I_IF_START(){101;}
180sub I_IF_END(){102;}
181sub I_VARIABLE_START(){103;}
182sub I_VARIABLE_END(){104;}
183sub I_VARIABLE_SCOPE_END(){105;}
184sub I_ASSIGN_START(){106;}
185sub I_ASSIGN_END(){107;}
186sub I_ELSE_START(){108;}
187sub I_ELSE_END(){109;}
188sub I_ELSIF_START(){110;}
189sub I_ELSIF_END(){111;}
190sub I_BUFFER_START(){112;}
191sub I_BUFFER_END(){113;}
192sub I_BUFFER_SCOPE_END(){114;}
193sub I_RES_BUFFER_START(){115;}
194sub I_RES_BUFFER_END(){116;}
195sub I_WITH_PARAM_START(){117;}
196sub I_WITH_PARAM_END(){118;}
197sub I_PARAMETER_START(){119;}
198sub I_RES_DOC_START(){120;}
199sub I_RES_DOC_END(){121;}
200sub I_FOR_EACH_ITEM(){122};
201sub I_WHILE(){123};
202
203# tokens
204$NCName = '[A-Za-z_][\w\\.\\-]*';
205$QName = "($NCName:)?$NCName";
206$NCWild = "${NCName}:\\*|\\*:${NCName}";
207$QNWild = "\\*";
208$NODE_TYPE = '((text|comment|processing-instruction|node|cdata)\\(\\))';
209$NUMBER_RE = '\d+(\\.\d*)?|\\.\d+';
210$DOUBLE_RE = '\d+(\\.\d*)?[eE][+-]?\d+';
211$LITERAL = '\\"[^\\"]*\\"|\\\'[^\\\']*\\\'';
212$URIREF = '[a-z][\w\;\/\?\:\@\&\=\+\$\,\-\_\.\!\~\*\'\(\)\%]+';
213
214# --------------------------------------------------
215# error processing
216# --------------------------------------------------
217
218sub doError {
219    my ($self, $no, $sev, @params) = @_;
220    my ($pkg, $file, $line, $sub) = caller(1);
221
222    my %severity = ( 1 => 'Warning',
223		     2 => 'Recoverable Error',
224		     3 => 'Fatal Error' );
225
226    my $orig;
227    if ($no == 1)      { $orig = 'STXPath Tokenizer'   }
228    elsif ($no < 100)  { $orig = 'STXPath Evaluator'    }
229    elsif ($no < 200)  { $orig = 'STXPath Function'    }
230    elsif ($no < 500)  { $orig = 'Stylesheet Parser' }
231    elsif ($no < 1000) { $orig = 'Runtime Engine'  }
232    else               { $orig = 'XML Parser'}
233
234    my $msg = $self->_err_msg($no, @params);
235
236    my $txt = "[XML::STX $severity{$sev} $no] $orig: $msg!\n";
237
238    if (exists $self->{locator}) {
239	$txt .= "URI: $self->{locator}->{SystemId}, ";
240	$txt .= "LINE: $self->{locator}->{LineNumber}\n";
241    }
242
243    if ($self->{DBG} or (exists $self->{STX} and $self->{STX}->{DBG})) {
244	$txt .= "DEBUG INFO: subroutine: $sub, line: $line\n"
245    }
246
247    my $eL = exists $self->{STX} ? $self->{STX}->{ErrorListener}
248      : $self->{ErrorListener};
249
250    if ($sev == 1) {
251	$eL->warning({Message => $txt, Exception => $no});
252
253    } elsif ($sev == 2) {
254	$eL->error({Message => $txt, Exception => $no});
255
256    } else {
257	$eL->fatal_error({Message => $txt, Exception => $no});
258    }
259}
260
261sub set_document_locator {
262    my ($self, $locator) = @_;
263
264    $self->{locator} = $locator;
265}
266
267sub _err_msg {
268    my $self = shift;
269    my $no = shift;
270    my @params = @_;
271
272    my %msg = (
273
274	# STXPath engine
275	1 => "Invalid query:\n_P\n_P^^^",
276	2 => "_P expression failed to parse - junk after end: _P",
277	3 => "Invalid parenthesized expression: _P not expected",
278	4 => "Error in expression - //..",
279	5 => "Error in expression - .._P",
280	6 => "Error in expression - _P not expected",
281	7 => "Incorrect match pattern: [ expected instead of _P",
282	8 => "Unknown kind-test - something is wrong",
283	9 => "Predicate not terminated: ] expected instead of _P",
284	10 => "Prefix _P not bound",
285	11 => "Conversion of _P to number failed: NaN",
286	12 => "Function _P not supported",
287	13 => "( expected after function name (_P), _P found instead",
288	14 => ", or ) expected after function argument (_P), _P found instead",
289	15 => "Incorrect number (_P) of arguments; _P() has _P arguments",
290	16 => "Variable _P not visible",
291	17 => "Namespace nodes can only be associated with elements, _P found",
292	18 => "Collation _P is ignored in _P() function",
293
294	# STXPath functions
295        101 => "Unknown data type: _P",
296        102 => "String value not defined for _P nodes",
297        103 => "Unknown node type: _P",
298        104 => "Empty sequence can't be converted to _P",
299        105 => "_P() function requires a _P argument (_P passed)",
300        106 => "Invalid position: item _P requested from sequence of _P items",
301        107 => "Invalid position: item _P requested. Indexes start from 1",
302        108 => "Invalid argument to _P() function: _P",
303        109 => "Invalid string-pad count: _P",
304
305	# Stylesheet parser
306        201 => "Chunk after the end of document element",
307        202 => "_P not allowed as document element (use <stx:transform>)",
308        203 => "Only one instance of <_P> is allowed in stylesheet",
309        204 => "visibility=\"_P\" (must be 'local', 'group' or 'global')",
310        205 => "_P=\"_P\" (must be either 'yes' or 'no')",
311        206 => "pass-through=\"_P\" (must be 'none','all' or 'text')",
312        207 => "stx:attribute must be preceded by element start (i_P found)",
313        208 => "_P instructions must not be nested",
314        209 => "_P instruction not supported",
315        210 => "_P - literal elements must be NS qualified outside templates",
316        211 => "_P _P is redeclared in the same scope",
317        212 => "_P must contain the _P mandatory attribute",
318        213 => "_P attribute of _P can't contain {...}",
319        214 => "_P attribute of _P must be _P",
320        215 => "_P not allowed at this point (as child of _P)",
321        216 => "Static evaluation failed, _P requires a context",
322        217 => "Value of _P attribute (_P) must be _P",
323        218 => "_P must follow immediately behind _P (found behind i_P)",
324        219 => "Duplicate name of _P: _P",
325        220 => "Duplicate name of procedure _P in precedence category _P",
326        221 => "Prefix _P used in _P not declared",
327        222 => "Test expression for <stx:while> contains no variable (_P)",
328
329	# Runtime
330        501 => "Prefix in <stx:element name=\"_P\"> not declared",
331        502 => "_P attribute of _P must evaluate to _P (_P)",
332        503 => "Output not well-formed: </_P> expected instead of </_P>",
333        504 => "Output not well-formed: </_P> found after end of document",
334        505 => "Assignment failed: _P _P not declared in this scope",
335        506 => "Position not defined for attributes, 1 returned",
336        507 => "Group named '_P' not defined",
337        508 => "Called procedure _P not visible",
338        509 => "_P is not valid _P for TrAX API",
339        510 => "Required parameter _P hasn't been supplied",
340	);
341
342    my $msg = $msg{$no};
343    foreach (@params) {	$msg =~ s/_P/$_/; }
344    return $msg;
345}
346
347# --------------------------------------------------
348# utils
349# --------------------------------------------------
350
351sub _type($) {
352    my ($self, $seq) = @_;
353    my $type = 'unknown';
354
355    if ($seq->[0]) {
356	if ($seq->[0]->[1] == STX_STRING) {$type = 'string'}
357	elsif ($seq->[0]->[1] == STX_BOOLEAN) {$type = 'boolean'}
358	elsif ($seq->[0]->[1] == STX_NUMBER) {$type = 'number'}
359	elsif ($seq->[0]->[1] == STX_NODE) {
360	    $type = 'node';
361	    if ($seq->[0]->[0]->{Type} == STX_ELEMENT_NODE) {
362		$type .= '-element';
363	    } elsif ($seq->[0]->[0]->{Type} == STX_ATTRIBUTE_NODE) {
364		$type .= '-attribute';
365	    } elsif ($seq->[0]->[0]->{Type} == STX_TEXT_NODE) {
366		$type .= '-text';
367	    } elsif ($seq->[0]->[0]->{Type} == STX_CDATA_NODE) {
368		$type .= '-cdata';
369	    } elsif ($seq->[0]->[0]->{Type} == STX_PI_NODE) {
370		$type .= '-processing-instruction';
371	    } elsif ($seq->[0]->[0]->{Type} == STX_COMMENT_NODE) {
372		$type .= '-comment';
373	    } else {
374		$type .= '-root';
375	    }
376	}
377
378    } else {
379	$type = 'empty sequence';
380    }
381    return $type;
382}
383
384sub _counter_key($) {
385    my ($self, $tok) = @_;
386
387    $tok =~ s/^node\(\)$/\/node/
388      or $tok =~ s/^text\(\)$/\/text/
389	or $tok =~ s/^cdata\(\)$/\/cdata/
390	  or $tok =~ s/^comment\(\)$/\/comment/
391	    or $tok =~ s/^processing-instruction\(\)$/\/pi/
392	      or $tok =~ s/^processing-instruction:(.*)$/\/pi:$1/
393		or $tok = index($tok, ':') > 0 ? $tok : ':' . $tok;
394    $tok =~ s/\*/\/star/;
395
396    return $tok;
397}
398
399sub _to_sequence {
400    my ($self, $value) = @_;
401
402    if ($value =~ /^($NUMBER_RE|$DOUBLE_RE)$/) {
403	return [[$1, STX_NUMBER]]
404
405    } else {
406	return [[$value, STX_STRING]];
407    }
408}
409
4101;
411__END__
412
413=head1 XML::STX::Base
414
415XML::STX::Base - basic definitions for XML::STX
416
417=head1 SYNOPSIS
418
419no API
420
421=head1 AUTHOR
422
423Petr Cimprich (Ginger Alliance), petr@gingerall.cz
424
425=head1 SEE ALSO
426
427XML::STX, perl(1).
428
429=cut
430
431
432