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