XML::STX::Base - basic definitions for XML::STX

package XML::STX::Base;

require 5.005_02;
BEGIN { require warnings if $] >= 5.006; }
use strict ('refs', 'subs');
use vars qw(@EXPORT);
use XML::STX::Writer;
use XML::SAX::PurePerl;
require Exporter;
@XML::STX::Base::ISA = qw(Exporter);

# --------------------------------------------------
# common constants
# --------------------------------------------------
@EXPORT = qw( STX_ELEMENT_NODE 
	      STX_TEXT_NODE
	      STX_CDATA_NODE
	      STX_PI_NODE
	      STX_COMMENT_NODE
	      STX_ATTRIBUTE_NODE
	      STX_ROOT_NODE

              STX_NODE
              STX_BOOLEAN
              STX_NUMBER
              STX_STRING

	      STX_NS_URI
	      STX_FNS_URI
	      STX_VERSION
	      XMLNS_URI

              STXE_START_DOCUMENT
	      STXE_END_DOCUMENT
	      STXE_START_ELEMENT
	      STXE_END_ELEMENT
	      STXE_CHARACTERS
	      STXE_PI
	      STXE_START_CDATA
	      STXE_END_CDATA
	      STXE_COMMENT
	      STXE_START_BUFFER
	      STXE_END_BUFFER
	      STXE_START_PREF
	      STXE_END_PREF

	      I_LITERAL_START
	      I_LITERAL_END
	      I_ELEMENT_START
	      I_ELEMENT_END
	      I_P_CHILDREN_START
	      I_P_CHILDREN_END
	      I_P_SIBLINGS_START
	      I_P_SIBLINGS_END
	      I_P_SELF_START
	      I_P_SELF_END
	      I_P_BUFFER_START
	      I_P_BUFFER_END
	      I_P_DOC_START
	      I_P_DOC_END
	      I_P_ATTRIBUTES_START
	      I_P_ATTRIBUTES_END
              I_CALL_PROCEDURE_START
              I_CALL_PROCEDURE_END
	      I_CHARACTERS
	      I_COPY_START
	      I_COPY_END
              I_ATTRIBUTE_START
	      I_ATTRIBUTE_END
	      I_CDATA_START
	      I_CDATA_END
	      I_COMMENT_START
	      I_COMMENT_END
	      I_PI_START
	      I_PI_END
	      
	      I_IF_START
	      I_IF_END
	      I_VARIABLE_START
	      I_VARIABLE_END
	      I_VARIABLE_SCOPE_END
	      I_ASSIGN_START
	      I_ASSIGN_END
	      I_ELSE_START
	      I_ELSE_END
	      I_ELSIF_START
	      I_ELSIF_END
              I_BUFFER_START
              I_BUFFER_END
              I_BUFFER_SCOPE_END
              I_RES_BUFFER_START
              I_RES_BUFFER_END
              I_RES_DOC_START
              I_RES_DOC_END
	      I_WITH_PARAM_START
	      I_WITH_PARAM_END
	      I_PARAMETER_START
              I_FOR_EACH_ITEM
              I_WHILE

	      $NCName
	      $QName
	      $NCWild
	      $QNWild
	      $NODE_TYPE
	      $NUMBER_RE
	      $DOUBLE_RE
	      $LITERAL
              $URIREF
	    );

# node types
sub STX_ELEMENT_NODE(){1;}
sub STX_TEXT_NODE(){2;}
sub STX_CDATA_NODE(){3;}
sub STX_PI_NODE(){4;}
sub STX_COMMENT_NODE(){5;}
sub STX_ATTRIBUTE_NODE(){6;}
sub STX_ROOT_NODE(){7;}

# atomic data types
sub STX_NODE(){1;}
sub STX_BOOLEAN(){2;}
sub STX_NUMBER() {3;}
sub STX_STRING() {4;}

# STX constants
sub STX_NS_URI() {'http://stx.sourceforge.net/2002/ns'};
sub STX_FNS_URI() {'http://stx.sourceforge.net/2003/functions'};
sub STX_VERSION() {'1.0'};
sub XMLNS_URI() {'http://www.w3.org/2000/xmlns/'};

# events
sub STXE_START_DOCUMENT(){1;}
sub STXE_END_DOCUMENT(){2;}
sub STXE_START_ELEMENT(){3;}
sub STXE_END_ELEMENT(){4;}
sub STXE_CHARACTERS(){5;}
sub STXE_PI(){6;}
sub STXE_START_CDATA(){7;}
sub STXE_END_CDATA(){8;}
sub STXE_COMMENT(){9;}
sub STXE_START_BUFFER(){10;}
sub STXE_END_BUFFER(){11;}
sub STXE_START_PREF(){12;}
sub STXE_END_PREF(){13;}

# instructions
sub I_LITERAL_START(){1;}
sub I_LITERAL_END(){2;}
sub I_ELEMENT_START(){3;}
sub I_ELEMENT_END(){4;}
sub I_P_CHILDREN_START(){5;}
sub I_P_CHILDREN_END(){6;}
sub I_CHARACTERS(){7;}
sub I_COPY_START(){8;}
sub I_COPY_END(){9;}
sub I_ATTRIBUTE_START(){10;}
sub I_ATTRIBUTE_END(){11;}
sub I_CDATA_START(){12;}
sub I_CDATA_END(){13;}
sub I_COMMENT_START(){14;}
sub I_COMMENT_END(){15;}
sub I_PI_START(){16;}
sub I_PI_END(){17;}
sub I_P_SELF_START(){18;}
sub I_P_SELF_END(){19;}
sub I_P_ATTRIBUTES_START(){20;}
sub I_P_ATTRIBUTES_END(){21;}
sub I_CALL_PROCEDURE_START(){22;}
sub I_CALL_PROCEDURE_END(){23;}
sub I_P_BUFFER_START(){24;}
sub I_P_BUFFER_END(){25;}
sub I_P_DOC_START(){26;}
sub I_P_DOC_END(){27;}
sub I_P_SIBLINGS_START(){28;}
sub I_P_SIBLINGS_END(){29;}

sub I_IF_START(){101;}
sub I_IF_END(){102;}
sub I_VARIABLE_START(){103;}
sub I_VARIABLE_END(){104;}
sub I_VARIABLE_SCOPE_END(){105;}
sub I_ASSIGN_START(){106;}
sub I_ASSIGN_END(){107;}
sub I_ELSE_START(){108;}
sub I_ELSE_END(){109;}
sub I_ELSIF_START(){110;}
sub I_ELSIF_END(){111;}
sub I_BUFFER_START(){112;}
sub I_BUFFER_END(){113;}
sub I_BUFFER_SCOPE_END(){114;}
sub I_RES_BUFFER_START(){115;}
sub I_RES_BUFFER_END(){116;}
sub I_WITH_PARAM_START(){117;}
sub I_WITH_PARAM_END(){118;}
sub I_PARAMETER_START(){119;}
sub I_RES_DOC_START(){120;}
sub I_RES_DOC_END(){121;}
sub I_FOR_EACH_ITEM(){122};
sub I_WHILE(){123};

# tokens
$NCName = '[A-Za-z_][\w\\.\\-]*';
$QName = "($NCName:)?$NCName";
$NCWild = "${NCName}:\\*|\\*:${NCName}";
$QNWild = "\\*";
$NODE_TYPE = '((text|comment|processing-instruction|node|cdata)\\(\\))';
$NUMBER_RE = '\d+(\\.\d*)?|\\.\d+';
$DOUBLE_RE = '\d+(\\.\d*)?[eE][+-]?\d+';
$LITERAL = '\\"[^\\"]*\\"|\\\'[^\\\']*\\\'';
$URIREF = '[a-z][\w\;\/\?\:\@\&\=\+\$\,\-\_\.\!\~\*\'\(\)\%]+';

# --------------------------------------------------
# error processing
# --------------------------------------------------

sub doError {
    my ($self, $no, $sev, @params) = @_;
    my ($pkg, $file, $line, $sub) = caller(1);

    my %severity = ( 1 => 'Warning', 
		     2 => 'Recoverable Error', 
		     3 => 'Fatal Error' );

    my $orig;
    if ($no == 1)      { $orig = 'STXPath Tokenizer'   } 
    elsif ($no < 100)  { $orig = 'STXPath Evaluator'    }
    elsif ($no < 200)  { $orig = 'STXPath Function'    }
    elsif ($no < 500)  { $orig = 'Stylesheet Parser' }
    elsif ($no < 1000) { $orig = 'Runtime Engine'  }
    else               { $orig = 'XML Parser'}

    my $msg = $self->_err_msg($no, @params);

    my $txt = "[XML::STX $severity{$sev} $no] $orig: $msg!\n";

    if (exists $self->{locator}) {
	$txt .= "URI: $self->{locator}->{SystemId}, ";
	$txt .= "LINE: $self->{locator}->{LineNumber}\n";
    }

    if ($self->{DBG} or (exists $self->{STX} and $self->{STX}->{DBG})) {
	$txt .= "DEBUG INFO: subroutine: $sub, line: $line\n"
    }

    my $eL = exists $self->{STX} ? $self->{STX}->{ErrorListener}
      : $self->{ErrorListener};

    if ($sev == 1) {
	$eL->warning({Message => $txt, Exception => $no});

    } elsif ($sev == 2) {
	$eL->error({Message => $txt, Exception => $no});

    } else {
	$eL->fatal_error({Message => $txt, Exception => $no});
    }
}

sub set_document_locator {
    my ($self, $locator) = @_;
    
    $self->{locator} = $locator;
}

sub _err_msg {
    my $self = shift;
    my $no = shift;
    my @params = @_;

    my %msg = (

	# STXPath engine       
	1 => "Invalid query:\n_P\n_P^^^",
	2 => "_P expression failed to parse - junk after end: _P",
	3 => "Invalid parenthesized expression: _P not expected",
	4 => "Error in expression - //..",
	5 => "Error in expression - .._P",
	6 => "Error in expression - _P not expected",
	7 => "Incorrect match pattern: [ expected instead of _P",
	8 => "Unknown kind-test - something is wrong",
	9 => "Predicate not terminated: ] expected instead of _P",
	10 => "Prefix _P not bound",
	11 => "Conversion of _P to number failed: NaN",
	12 => "Function _P not supported",
	13 => "( expected after function name (_P), _P found instead",
	14 => ", or ) expected after function argument (_P), _P found instead",
	15 => "Incorrect number (_P) of arguments; _P() has _P arguments",
	16 => "Variable _P not visible",
	17 => "Namespace nodes can only be associated with elements, _P found",
	18 => "Collation _P is ignored in _P() function",

	# STXPath functions
        101 => "Unknown data type: _P",
        102 => "String value not defined for _P nodes",
        103 => "Unknown node type: _P",
        104 => "Empty sequence can't be converted to _P",
        105 => "_P() function requires a _P argument (_P passed)",
        106 => "Invalid position: item _P requested from sequence of _P items",
        107 => "Invalid position: item _P requested. Indexes start from 1",
        108 => "Invalid argument to _P() function: _P",
        109 => "Invalid string-pad count: _P",

	# Stylesheet parser
        201 => "Chunk after the end of document element",
        202 => "_P not allowed as document element (use <stx:transform>)",
        203 => "Only one instance of <_P> is allowed in stylesheet",
        204 => "visibility=\"_P\" (must be 'local', 'group' or 'global')",
        205 => "_P=\"_P\" (must be either 'yes' or 'no')",
        206 => "pass-through=\"_P\" (must be 'none','all' or 'text')",
        207 => "stx:attribute must be preceded by element start (i_P found)",
        208 => "_P instructions must not be nested",
        209 => "_P instruction not supported",
        210 => "_P - literal elements must be NS qualified outside templates",
        211 => "_P _P is redeclared in the same scope",
        212 => "_P must contain the _P mandatory attribute",
        213 => "_P attribute of _P can't contain {...}",
        214 => "_P attribute of _P must be _P",
        215 => "_P not allowed at this point (as child of _P)",
        216 => "Static evaluation failed, _P requires a context",
        217 => "Value of _P attribute (_P) must be _P",
        218 => "_P must follow immediately behind _P (found behind i_P)",
        219 => "Duplicate name of _P: _P",
        220 => "Duplicate name of procedure _P in precedence category _P",
        221 => "Prefix _P used in _P not declared",
        222 => "Test expression for <stx:while> contains no variable (_P)",

	# Runtime
        501 => "Prefix in <stx:element name=\"_P\"> not declared",
        502 => "_P attribute of _P must evaluate to _P (_P)",
        503 => "Output not well-formed: </_P> expected instead of </_P>",
        504 => "Output not well-formed: </_P> found after end of document",
        505 => "Assignment failed: _P _P not declared in this scope",
        506 => "Position not defined for attributes, 1 returned",
        507 => "Group named '_P' not defined",
        508 => "Called procedure _P not visible",
        509 => "_P is not valid _P for TrAX API",
        510 => "Required parameter _P hasn't been supplied",
	);

    my $msg = $msg{$no};
    foreach (@params) {	$msg =~ s/_P/$_/; }
    return $msg;
}

# --------------------------------------------------
# utils
# --------------------------------------------------

sub _type($) {
    my ($self, $seq) = @_;
    my $type = 'unknown';

    if ($seq->[0]) {
	if ($seq->[0]->[1] == STX_STRING) {$type = 'string'}
	elsif ($seq->[0]->[1] == STX_BOOLEAN) {$type = 'boolean'}
	elsif ($seq->[0]->[1] == STX_NUMBER) {$type = 'number'}
	elsif ($seq->[0]->[1] == STX_NODE) {
	    $type = 'node';
	    if ($seq->[0]->[0]->{Type} == STX_ELEMENT_NODE) {
		$type .= '-element';
	    } elsif ($seq->[0]->[0]->{Type} == STX_ATTRIBUTE_NODE) {
		$type .= '-attribute';
	    } elsif ($seq->[0]->[0]->{Type} == STX_TEXT_NODE) {
		$type .= '-text';
	    } elsif ($seq->[0]->[0]->{Type} == STX_CDATA_NODE) {
		$type .= '-cdata';
	    } elsif ($seq->[0]->[0]->{Type} == STX_PI_NODE) {
		$type .= '-processing-instruction';
	    } elsif ($seq->[0]->[0]->{Type} == STX_COMMENT_NODE) {
		$type .= '-comment';
	    } else {
		$type .= '-root';
	    }
	}

    } else {
	$type = 'empty sequence';	
    }
    return $type;
}

sub _counter_key($) {
    my ($self, $tok) = @_;

    $tok =~ s/^node\(\)$/\/node/ 
      or $tok =~ s/^text\(\)$/\/text/ 
	or $tok =~ s/^cdata\(\)$/\/cdata/ 
	  or $tok =~ s/^comment\(\)$/\/comment/
	    or $tok =~ s/^processing-instruction\(\)$/\/pi/ 
	      or $tok =~ s/^processing-instruction:(.*)$/\/pi:$1/ 
		or $tok = index($tok, ':') > 0 ? $tok : ':' . $tok;
    $tok =~ s/\*/\/star/;

    return $tok;
}

sub _to_sequence {
    my ($self, $value) = @_;

    if ($value =~ /^($NUMBER_RE|$DOUBLE_RE)$/) {
	return [[$1, STX_NUMBER]]

    } else {
	return [[$value, STX_STRING]];
    }
}

1;
__END__