BioMart::Web CGIXSLT
Package variablesGeneral documentationMethods
Toolbar
WebCvsRaw content
Package variables
Privates (from "my" definitions)
$namber_of_exprs = 2
@local_vars_names = ()
%template_modes = ()
%_html_empty = ('area'=>1,'base'=>1,'basefont'=>1, 'br'=>1, 'col'=>1,'frame'=>1, 'hr'=>1, 'img'=>1, 'input'=>1, 'isindex'=>1, 'link'=>1, 'meta'=>1,'param'=>1,'colgroup'=>1, 'dd'=>1, 'dt'=>1, 'li'=>1, 'option'=>1, 'p'=>1, 'td'=>1, 'tfoot'=>1, 'th'=>1,'thead'=>1,'tr'=>1)
@_http_contents = ()
$param_nums = 0
$output_encoding = ''
$_xml_base_flag = 0
$_http_flag = 1
$output_method = ''
%stylesheet_keys = ()
%glob_vars = ()
$output_indent = ''
$_is_number = '^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$'
$_root = undef
@compiled_expresions = (undef,$_default_path_expr)
%glob_objects = ()
$cgi_object = undef
@_opened_stylesheets = ()
%_xpath_boolean = ('false'=>1,'true'=>1,'boolean'=>1,'not'=>1,'='=>1,'!='=>1,'and'=>1,'or'=>1,'>'=>1,'<'=>1,'>='=>1,'<='=>1,'contains'=>1,'starts-with'=>1,'save-file'=>1)
$omit_xmldecl = 'no'
@local_vars_values = ()
@literal_replace = undef
@stack_1 = ()
$result_prefix = ''
$_http_output = 1
%_axis_code = ('descendant-or-self'=>1,'self'=>2,'parent'=>3,'descendant'=>4,'preceding-sibling'=>5,'following-sibling'=>6,'ancestor'=>7,'ancestor-or-self'=>8)
$MAX_CONTENT_SIZE = 1024
%key_names = ()
%_one_arg_func = ('boolean'=>1,'count'=>1,'false'=>1, 'last'=>1,'name'=>1,'normalize-space'=>1,'time'=>1, 'not'=>1,'number'=>1,'position'=>1,'string'=>1,'string-length'=>1, 'sum'=>1,'true'=>1,'file-name'=>1,'system-property'=>1)
%_html_codes_el = ('script'=>1,'SCRIPT'=>1,'Script'=>1,'style'=>1,'STYLE'=>1,'Style'=>1)
%template_names = ()
%glob_strings = ()
$CHARS_MODEL = ''
%XS_PARAMS = ()
@_http_fields = ()
$_source_style = ''
$stylesheet_prefix = ''
$xsltp_error_message = undef
Included modules
XML::Parser
Synopsis
No synopsis!
Description
No description!
Methods
ancestors
No description
Code
apply_templates
No description
Code
attr_value
No description
Code
chdata
No description
Code
chdata_b
No description
Code
choose
No description
Code
collect_arg
No description
Code
compile_expr
No description
Code
compile_expr_param
No description
Code
compile_func_call
No description
Code
compile_instr_attr_f
No description
Code
compile_stylesheet
No description
Code
conditions_array
No description
Code
convert_nodeset
No description
Code
createtree
No description
Code
decl
No description
Code
do_sort
No description
Code
elend
No description
Code
elstart
No description
Code
elstart_b
No description
Code
error_log
No description
Code
eval_element
No description
Code
eval_expr
No description
Code
eval_instruction
No description
Code
eval_key_func
No description
Code
eval_template
No description
Code
exiting_code
No description
Code
extract_sort
No description
Code
file_name
No description
Code
filter_node_seq
No description
Code
find_child_at
No description
Code
find_child_position
No description
Code
for_each
No description
Code
get_attr_value
No description
Code
get_var_val
No description
Code
gmt_time
No description
Code
group
No description
Code
group_op
No description
Code
has_preceding_node
No description
Code
init
No description
Code
init_loc_params
No description
Code
init_sort
No description
Code
install_expresion
No description
Code
install_key
No description
Code
install_stylesheet
No description
Code
install_template
No description
Code
install_templates
No description
Code
is_boolean
No description
Code
is_equal
No description
Code
is_expr_nodeset
No description
Code
is_file_name_notsafe
No description
Code
is_template_not_empty
No description
Code
n_comparison
No description
Code
named_ancestors
No description
Code
newnode
No description
Code
node_seq
No description
Code
node_seq_from_root
No description
Code
node_set_to_str
No description
Code
node_text
No description
Code
norm_space
No description
Code
op_code
No description
Code
parse_expresion
No description
Code
parse_step_pattern
No description
Code
pattern_to_expr
No description
Code
prepare_path
No description
Code
prepare_step_path
No description
Code
prepare_var_expr
No description
Code
print_doc
No description
Code
print_error
No description
Code
print_http_headers
No description
Code
print_output
No description
Code
print_tree_html
No description
Code
print_tree_text
No description
Code
print_tree_xml
No description
Code
print_with_method
No description
Code
read_https
No description
Code
read_xml_file
No description
Code
read_xsl_file
No description
Code
save_to_file
No description
Code
save_upload_file
No description
Code
scanelemets
No description
Code
scannames
No description
Code
scannodes
No description
Code
select_condition
No description
Code
select_template
No description
Code
set_atts_flag
No description
Code
set_glob_params
No description
Code
set_loc_params
No description
Code
set_template_key
No description
Code
st_pi
No description
Code
strip_all_spaces
No description
Code
strip_st_spaces
No description
Code
transform
No description
Code
tree_fragment
No description
Code
try_correct_arg
No description
Code
value_of
No description
Code
var_value
No description
Code
xml_file
No description
Code
xpath_errors
No description
Code
xsl_attribute
No description
Code
xsl_call_template
No description
Code
xsl_comment
No description
Code
xsl_copy
No description
Code
xsl_copy_of
No description
Code
xsl_document
No description
Code
xsl_element
No description
Code
xsl_if
No description
Code
xsl_message
No description
Code
xsl_number
No description
Code
xsl_param
No description
Code
xsl_text
No description
Code
xsl_union
No description
Code
xsl_var
No description
Code
Methods description
None available.
Methods code
ancestorsdescriptionprevnextTop
sub ancestors {
  my ($tselect,$newpath,$tseq)=@_;
  					  while($newpath->[0])
						 {my $tpath=[@{$newpath}];
						  node_seq($tselect,$newpath,$tseq);
						  shift @{$tpath};
						  $newpath=$tpath;
						 };
}
apply_templatesdescriptionprevnextTop
sub apply_templates {
	my ($instr,$stpath,$rtpath)=@_;
	my $code=$instr->{cselect};
 if(defined($code))
 {  my $mode=$instr->{attslist}->{'mode'};
    my $t_keys=$template_modes{$mode};
	my $nump=$instr->{nparams};
	my $node_paths=eval_expr($code,$stpath,2);
	if($instr->{'sort'}){$node_paths=do_sort(0,$instr->{'sort'},$node_paths);};
	if($nump){init_loc_params($instr,$stpath);};
	push @_focus_stack_,$_focus_;
	push @_count_stack_,$_position_;
	$_focus_=$node_paths;
	$_position_=0;
	$_last_=0;
	for my $path (@{$node_paths})
	{   $_position_++;
		my $t=select_template($path,$t_keys);
		if($t){$param_nums=$nump;eval_template($t,$path,$rtpath);}
		else{
			my $node=$path->[0];
			my $rnode=$rtpath->[0];
			if($node->{nodename} eq 'text()')
				{push @{$rnode->{children}},$node;}
			elsif($node->{nodename}=~/^@/)
				{push @{$rnode->{children}},newnode('text()',$node->{nodedata});}
			else{apply_templates($_default_template,$path,$rtpath);};
		    };
	};
	$_focus_=pop @_focus_stack_;
	$_position_=pop @_count_stack_;
	$_last_=0;
    while($nump>0){shift @local_vars_names;shift @local_vars_values;$nump--;};
 }
 else
	{ my $mode=$instr->{attslist}->{'mode'};
      $code=$instr->{attslist}->{'select'};
      if(!$mode){$instr->{attslist}->{'mode'}='no';};
	   if(!defined($code)){$instr->{cselect}=$_default_path_expr;
	                       set_loc_params($instr);
	                       apply_templates($instr,$stpath,$rtpath);}
	   else
		{ my $cexpr=compile_instr_attr_f($instr,'select');
		  if(is_expr_nodeset($cexpr))
			{set_loc_params($instr);apply_templates($instr,$stpath,$rtpath);}
	      else{exiting_code("xsl:apply\-templates has invalid select attribute\n$code\n");};
		};
	};
}
attr_valuedescriptionprevnextTop
sub attr_value {
	my ($anode,$snodepath,$rtpath)=@_;
	my $elist=$anode->{compiled};
	if(!defined($elist))
	{ my $str=$anode->{nodedata};
	  $elist=[];
	  while($str=~/^(.*?)\{(.*?)\}(.*)/s)
	  {if($1 ne ''){push @{$elist}, $1;};
	   my $sexpr=$2;
	   $str=$3;
           my  $code=parse_expresion($sexpr);
			 if($code<0)
		      {push @{$elist},$compiled_expresions[-$code];}
             else
		      {exiting_code("invalid expression $anode->{nodedata} in attribute value\n");};
	  };
	  if($str ne ''){push @{$elist}, $str;};
	  $anode->{compiled}=$elist;
	};
	my $nstr='';
	for my $ex (@{$elist}){$nstr.=eval_expr($ex,$snodepath,1);};
	return $nstr;
}
chdatadescriptionprevnextTop
sub chdata {
	my ($p, $str)=@_;
	my $i=$#{$_root->{children}};
	if($i>=0)
	   {
	my $chlast=$_root->{children}->[$i];
	if($chlast->{nodename} eq 'text()'){$chlast->{nodedata}.=$str;goto END;};
	   };
	my $n={};
	$n->{nodename}='text()';
	$n->{children}=[];
	$n->{nodedata}=$str;
	push @{$_root->{children}}, $n;
	END:
}
chdata_bdescriptionprevnextTop
sub chdata_b {
	my $p=$_[0];
	my $str=$p->original_string();
	if($str=~/\&/){
		$str=~s/\&lt\;/\</gs;
$str=~s/\&gt\;/\>/gs;
$str=~s/\&nbsp\;/\xA0/gs;
$str=~s/\&quot\;/\"/gs;
$str=~s/\&apos\;/\'/gs;
$str=~s/\&amp\;/\&/gs;
}; my $i=$#{$_root->{children}}; if($i>=0) { my $chlast=$_root->{children}->[$i]; if($chlast->{nodename} eq 'text()'){$chlast->{nodedata}.=$str;goto END;}; }; my $n={}; $n->{nodename}='text()'; $n->{children}=[]; $n->{nodedata}=$str; push @{$_root->{children}}, $n; END:
}
choosedescriptionprevnextTop
sub choose {
	my ($instr,$stpath,$rtpath)=@_;
    my $chs=$instr->{children};
FOR: for my $ch (@{$chs})
	 {  
		if($ch->{nodename} eq 'xsl:when')
		{my $code=$ch->{ctest};
 		   if(defined($code))
			{if(eval_expr($code,$stpath,0)){eval_template($ch,$stpath,$rtpath);last FOR;};}
           else
			{my $testexpr=compile_instr_attr_f($ch,'test');
		     if(eval_expr($testexpr,$stpath,0)){eval_template($ch,$stpath,$rtpath);last FOR;};
			};
		}
		else
		{     if($ch->{nodename} eq 'xsl:otherwise')
			  {eval_template($ch,$stpath,$rtpath);last FOR;};
		};
	 };
}
collect_argdescriptionprevnextTop
sub collect_arg {
my $op=shift;
 my $args=shift;
 if($op->{opname} eq ',')
	{unshift @{$args},$op->{right};
     my $nop=$op->{left};
	 if(ref($nop)){if($nop->{opname} eq ','){collect_arg($nop,$args);}
	               else{unshift @{$args},$nop;};}
     else{unshift @{$args},$nop;};
	};
 return $args;
}
compile_exprdescriptionprevnextTop
sub compile_expr {
 my $expr=shift;
if(!$_fotal_error_)
{
 if(!ref($expr))
 {
  my @groups=();
  group(0,$expr,'',\@groups);
  my $size=$#groups;
  if($size<0){return '';}
  elsif($size==0){return prepare_path($groups[0]);
  }
  elsif($size==1)
	{
	  compile_func_call(\@groups,-1,'');
	  if($_fotal_error_){return undef;};
	  return $groups[0];
	}
  else
	{ my $op_priority=0;
      my $op_min=8;
	  my $ngrs=[];
	  my $last_op=-1;
	    for my $arg (@groups)
		{   my $op_c=op_code($arg);
			if($op_c)
			{if($op_c>$op_priority){$op_priority=$op_c;};
			 if($op_min>$op_c){$op_min=$op_c;};
			 $last_op=compile_func_call($ngrs,$last_op,$arg);
			 if($_fotal_error_){return undef;};
			}
			else{push @{$ngrs}, $arg;};
	    };
		compile_func_call($ngrs,$last_op,'');
		if($_fotal_error_){return undef;};
		my $cgrs=$ngrs;
		$ngrs=[];
        while($op_priority>=$op_min)
		{   my $op_arg=shift @{$cgrs};
			while(defined($op_arg))
			{
 			if($op_priority==op_code($op_arg))
				{if($op_priority!=8)
					{
				 my $pre=pop @{$ngrs};
			     my $hr={};
				 $hr->{opname}=$op_arg;
				 $hr->{left}=compile_expr($pre);
                 $op_arg=shift @{$cgrs};
				 $hr->{right}=compile_expr($op_arg);
                 push @{$ngrs},$hr;
					}
                 else
					{
                 my $pre=pop @{$ngrs};
				 if(not(ref($pre)&&($pre->{opname} eq '|')))
				 {
					 my $hr={};$hr->{opname}='|';$hr->{param}=[];
				     push @{$hr->{param}},compile_expr($pre);
				     $pre=$hr;
				 };
				 $op_arg=shift @{$cgrs};push @{$pre->{param}},compile_expr($op_arg);
				 push @{$ngrs},$pre;
					};
				}
             else{push @{$ngrs}, $op_arg;};
			 $op_arg=shift @{$cgrs};
			};
			$op_priority--;
			$cgrs=$ngrs;
			$ngrs=[];
		};
		return $cgrs->[0];
	};
 }
 else {return $expr;};
}
else {return undef;};
}
compile_expr_paramdescriptionprevnextTop
sub compile_expr_param {
my $f_par=shift;
if($f_par=~/^\s*\//s)
{
my $param=compile_expr($f_par);
if($param->{opname} ne '/'){$_fotal_error_='FOTAL ERROR';xpath_errors(5);};
$param->{opname}='#';
return $param;
}
else{$_fotal_error_='FOTAL ERROR';xpath_errors(5);};
return undef;
}

my %_one_arg_func=('boolean'=>1,'count'=>1,'false'=>1,
	'last'=>1,'name'=>1,'normalize-space'=>1,'time'=>1,
	'not'=>1,'number'=>1,'position'=>1,'string'=>1,'string-length'=>1,
	'sum'=>1,'true'=>1,'file-name'=>1,'system-property'=>1);
}
compile_func_calldescriptionprevnextTop
sub compile_func_call {
    my $ngrs=shift;
     my $last_op=shift;
	 my $c_op=shift;
	 
	 my $last_arg=$#{$ngrs};
     if(($last_arg<0)&&($last_op<0))
	 {try_correct_arg($c_op,$ngrs);
	                                          return -1;}
	 elsif($last_arg==$last_op)
	 {    if(!op_code($ngrs->[$last_arg])){push @{$ngrs},$c_op;
	                                          return $last_arg+1;}
          elsif(($ngrs->[$last_arg] eq '*')||($ngrs->[$last_arg] eq 'mod')||($ngrs->[$last_arg] eq 'div')||($ngrs->[$last_arg] eq 'and')||($ngrs->[$last_arg] eq 'or'))
			  {$ngrs->[$last_arg]=' '.$ngrs->[$last_arg].' ';
		       while(($last_op>=0)and(!op_code($ngrs->[$last_op]))){$last_op--;};
		       goto func;}
	      else{try_correct_arg($c_op,$ngrs);
			                                  return $last_op;};
	 }
	 elsif(($last_arg-$last_op)==1){push @{$ngrs},$c_op;
	                                          return $last_arg+1;};
     
func:{   my @f_expr=();
	     while($last_arg>$last_op){unshift @f_expr, pop @{$ngrs};$last_arg--;}; 
			      my $f=shift @f_expr;
				  my $f_arg=shift @f_expr;
				  if($f eq '')
				    {          push @{$ngrs},compile_expr($f_arg);
					           $last_arg++;
					           if($c_op ne ''){push @{$ngrs},$c_op;
					                          $last_arg++;$last_op=$last_arg;};
				    }
				  else
					{
		              my $hr={};
	                  $hr->{opname}=$f;
                      if($_one_arg_func{$f}){if($f_arg!~/^\s*$/){$hr->{right}=compile_expr($f_arg);};}
					  elsif($f eq 'id'){$_fotal_error_='FOTAL ERROR';xpath_errors(7);}						 
					  elsif($f eq 'current')
						  {if(!$f_arg)
						     {$f_arg=shift @f_expr;
					                   if($f_arg)
						               {$hr->{right}=compile_expr_param($f_arg);}
									   else{$hr->{right}='';};
							 }else{$_fotal_error_='FOTAL ERROR';xpath_errors(5);};
						  }
                      elsif($f eq 'gmtime')
						  {if($f_arg){$hr->{left}=compile_expr($f_arg);};
					       $f_arg=shift @f_expr;if($f_arg){$hr->{right}=compile_expr_param($f_arg);};
						  }
                      elsif($f eq 'document')
						  {if($f_arg)
							  {my $harg=compile_expr($f_arg);
					           if(ref($harg))
								  {if($harg->{opname} eq ',')
									  {my $arg_list=[];
						               $arg_list=collect_arg($harg,$arg_list);
									   if($#{$arg_list}==1)
										  {$hr->{left}=$arg_list->[0];$hr->{right}=$arg_list->[1];
										  }else{$_fotal_error_='FOTAL ERROR';xpath_errors(5);};
									  }else{$hr->{left}=$harg;};
								  }else{$hr->{left}=$harg;};
							  }else{$_fotal_error_='FOTAL ERROR';xpath_errors(5);};
							  my $f_par=shift @f_expr;
					                   if($f_par)
						               {$hr->{param}=compile_expr_param($f_par);}
									   else{$hr->{param}='';};
						  }
                      else
					  { my $harg=compile_expr($f_arg);
					    if(ref($harg))
						  {if($harg->{opname} eq ',')
							{my $arg_list=[];
						     $arg_list=collect_arg($harg,$arg_list);
							 my $num_arg=$#{$arg_list};

                             if($f eq 'key')
						     {if($num_arg==1){$hr->{left}=$arg_list->[0];$hr->{right}=$arg_list->[1];}
							  else{$_fotal_error_='FOTAL ERROR';xpath_errors(6);};
						      my $f_par=shift @f_expr;
					                   if($f_par)
						               {$hr->{param}=compile_expr_param($f_par);}
									   else{$hr->{param}='';};
						     }
                             elsif(($f eq 'contains')||($f eq 'starts-with')||($f eq 'substring-after')||($f eq 'substring-before')||($f eq 'save-file'))
						     {if($num_arg==1){$hr->{left}=$arg_list->[0];$hr->{right}=$arg_list->[1];}
							  else{$_fotal_error_='FOTAL ERROR';xpath_errors(6);};
							 }
							 elsif($f eq 'substring')
						     {if($num_arg<=2)
							  {$hr->{left}=$arg_list->[0];$hr->{right}=$arg_list->[1];
							   if($num_arg==2){$hr->{param}=$arg_list->[2];}
							   else{$hr->{param}='';};
							  }else{$_fotal_error_='FOTAL ERROR';xpath_errors(6);};
						     }
                             elsif($f eq 'translate')
						     {if($num_arg==2)
							   {$hr->{left}=$arg_list->[0];$hr->{right}=$arg_list->[1];$hr->{param}=$arg_list->[2];}
					           else{$_fotal_error_='FOTAL ERROR';xpath_errors(6);};
						     }
							 elsif($f eq 'concat')
							 {if($num_arg>=1){$hr->{right}=$arg_list->[0];shift @{$arg_list};$hr->{param}=$arg_list;}
							 else{$_fotal_error_='FOTAL ERROR';xpath_errors(6);};  
							 };
							}else{$_fotal_error_='FOTAL ERROR';xpath_errors(6);};
						  }
						  else
						  {$_fotal_error_='FOTAL ERROR';xpath_errors(6);};
					  };
		              
					  push @{$ngrs},$hr;
					  $last_arg++;
					  if($c_op ne ''){push @{$ngrs},$c_op; 
					                          $last_arg++;$last_op=$last_arg;};
					};
 				  my $rest=$#f_expr;
				  if($rest>=0)
		          {$_fotal_error_='FOTAL ERROR';xpath_errors(4);};
  				                              return $last_op;
	 };
}
compile_instr_attr_fdescriptionprevnextTop
sub compile_instr_attr_f {
	my $instr=shift;
	my $attr_name=shift;
	my $attrval=$instr->{attslist}->{$attr_name};
	if(!defined($attrval)){exiting_code("$instr->{nodename} has no $attr_name attribute\n");};
	my $cattr_name='c'.$attr_name;
	my $code=parse_expresion($attrval);
	     if($code<0){$instr->{$cattr_name}=$compiled_expresions[-$code];}
		 else{exiting_code("$instr->{nodename} has invalid $attr_name attribute\n");};
   return $compiled_expresions[-$code];
}
compile_stylesheetdescriptionprevnextTop
sub compile_stylesheet {
my $st=shift;
 my $xml=shift;
 my $ts=[];
 my $vars=[];
 install_stylesheet($st,$ts,$vars);
 install_templates($ts);
 for my $var (@{$vars})
	{my $varname=$var->{attslist}->{name};
     if($varname)
	 {if((!defined($glob_vars{$varname}))&&(!defined($glob_strings{$varname}))&&(!defined($glob_objects{$varname})))
	  {my $startp=[$xml];
	   my $select=$var->{attslist}->{'select'};
	   if($select)
		 {my $code=parse_expresion($select);
	      if($code<0){$glob_vars{$varname}=eval_expr($compiled_expresions[-$code],$startp,2);}
		  else{exiting_code("glob var\" $varname\" has invalid select attribute\n");};
		 }
	   else
		 { if(is_template_not_empty($var)){strip_all_spaces($var);};
		   $glob_vars{$varname}=tree_fragment($var,$startp);};
	  }else{exiting_code("glob variable\" $varname\" has been defined already\n");};
	 };
	};
 for (my $i=0;$i<=$#_http_fields;$i++) {
	 my $startp=[$xml];
	 $_http_contents[$i]=norm_space(node_set_to_str(tree_fragment($_http_contents[$i],$startp)));
 };
}
conditions_arraydescriptionprevnextTop
sub conditions_array {
my $str=shift;
 my $array=[];
 while($str=~/^\[(.+?)\](.*)/)
	{push @{$array},$1;$str=$2;};
 return $array;
}

my %_axis_code=('descendant-or-self'=>1,'self'=>2,'parent'=>3,
'descendant'=>4,'preceding-sibling'=>5,'following-sibling'=>6,
'ancestor'=>7,'ancestor-or-self'=>8);
}
convert_nodesetdescriptionprevnextTop
sub convert_nodeset {
if($_[0]==1){return node_set_to_str($_[1]);}
elsif($_[0]==2){return $_[1];}
else{if($_[1]->[0]){return 1;}else{return 0;};};
}
createtreedescriptionprevnextTop
sub createtree {
my ($file,$f_type)=@_;

#my @stack=();
$_root=newnode('/',''); $_root->{attsnumb}=0;
}
decldescriptionprevnextTop
sub decl {
my ($p, $ver, $enc, $stalone)=@_;
 if(defined($enc) && ($enc eq 'bytes')){$p->setHandlers('Char'=>\&chdata_b,'Start'=>\&elstart_b);
 if(not($CHARS_MODEL)){$CHARS_MODEL='bytes';};
 }else{if(not($CHARS_MODEL)){$CHARS_MODEL='unicode';};};
}

my $p0=new XML::Parser(ErrorContext=>1);
$p0->setHandlers('XMLDecl'=>\&decl, 'Start'=>\&elstart, 'End'=>\&elend, 'Char'=>\&chdata);

if($f_type eq 'xml')
{
$file=file_name($XML_BASE,$file);
$p0->setHandlers('Proc'=>\&st_pi);
$XML_BASE=$file;
}
elsif($f_type eq 'xsl')
{
$file=file_name($XSLT_BASE,$file);
$XSLT_BASE=$file;
}
else
{die "no file type\n";};


eval{$p0->parsefile($file);};
if($@){error_log("XML error in file\" $file\"\: $@\n ");exiting_code("XML error cannot read data or file, see log file\n");};
if($f_type eq 'xsl'){push @_opened_stylesheets, $file}; 
return $_root;
}
do_sortdescriptionprevnextTop
sub do_sort {
my ($sort_i_num,$sort_instrs,$node_set)=@_;
 my $si=$sort_instrs->[$sort_i_num];
 if($si)
	{my $expr=$si->{cselect};
     my $d_type=$si->{attslist}->{'data-type'};
	 my $order=$si->{attslist}->{order};
	 my %skeys=();
	 for my $path (@{$node_set})
		{my $val=eval_expr($expr,$path,1);
	     if($skeys{$val}){push @{$skeys{$val}},$path;}
		 else{$skeys{$val}=[$path];};
		};
    my @sorted;
	if($d_type eq 'number')
		{if($order eq 'descending')
			{@sorted=sort{$CGIXSLT::b <=> $CGIXSLT::a} keys %skeys;}
         else
			{@sorted=sort{$CGIXSLT::a <=> $CGIXSLT::b} keys %skeys;};
		}
    else
		{if($order eq 'descending')
			{@sorted=sort{$CGIXSLT::b cmp $CGIXSLT::a} keys %skeys;}
         else
			{@sorted=sort keys %skeys;};
	    };
	my $r_node_set=[];
	for my $sval (@sorted)
		{my $l_ns=$skeys{$sval};
	     if($#{$l_ns}>0){$l_ns=do_sort($sort_i_num+1,$sort_instrs,$l_ns);};
		 push @{$r_node_set},@{$l_ns};
	    };
    return $r_node_set;
	}
 else{return $node_set;};
};
}
elenddescriptionprevnextTop
sub elend {
	my ($p, $el)=@_;
	$_root=pop @stack_1;
}
elstartdescriptionprevnextTop
sub elstart {
 
	my ($p, $el, %atts)=@_;
	my $n={};
	$n->{nodename}=$el;
	$n->{children}=[];
	$n->{nodedata}='';
	my $i=0;
	for my $aname (keys %atts) {
		my $anode={};
		$anode->{nodename}=join('','@',$aname);
		$anode->{nodedata}=$atts{$aname};
		$anode->{children}=[];
		push @{$n->{children}}, $anode;
		$i++;
	};
	$n->{attslist}={%atts};
	$n->{attsnumb}=$i;
	push @{$_root->{children}}, $n;
	push @stack_1, $_root;
	$_root=$n;
}
elstart_bdescriptionprevnextTop
sub elstart_b {
 
	my $p=$_[0];
	my $n={};
	my $elstr=$p->original_string();
	$elstr=~/^\<(.+?)[\s\/\>]/;
	my $el=$1;
	$n->{nodename}=$el;
	$n->{children}=[];
	$n->{nodedata}='';
	$elstr=substr($elstr,length($el)+2);
	$elstr=~s/\/?\>$//gs;
$elstr=~s/^\s+//g;
$elstr=~s/\s+$//g;
my $nattslist={}; if($elstr){ $elstr=~s/\s*(.+?)\s*\=\s*(\"|\')(.*?)\2/$nattslist->{$1}=$3;/egs;
}; my $i=0; for my $aname (keys %{$nattslist}) { my $anode={}; $anode->{nodename}=join('','@',$aname); if($nattslist->{$aname}=~/\&/){ my $str=$nattslist->{$aname}; $str=~s/\&lt\;/\</gs;
$str=~s/\&gt\;/\>/gs;
$str=~s/\&nbsp\;/\xA0/gs;
$str=~s/\&quot\;/\"/gs;
$str=~s/\&apos\;/\'/gs;
$str=~s/\&amp\;/\&/gs;
$nattslist->{$aname}=$str; }; $anode->{nodedata}=$nattslist->{$aname}; $anode->{children}=[]; push @{$n->{children}}, $anode; $i++; }; $n->{attslist}=$nattslist; $n->{attsnumb}=$i; push @{$_root->{children}}, $n; push @stack_1, $_root; $_root=$n;
}
error_logdescriptionprevnextTop
sub error_log {
my $err=shift;
	open(LOG,'>> xsltp.log') or die "cannot open log file";
	binmode(LOG);
	print LOG "ERROR:\n", $err;
	my $t=localtime(time);
	print LOG "DATE: ", $t,"\n";
	print LOG "REMOTE_ADDR: ", $ENV{'REMOTE_ADDR'},"\n";
	print LOG "PARAMETERS PASSED:\n";
	for my $key (keys %XS_PARAMS)
		{print LOG $key,'="',$XS_PARAMS{$key},'"',"\n";};
	print LOG '****************************',"\n";
	close(LOG);
}
eval_elementdescriptionprevnextTop
sub eval_element {
my ($e,$stpath,$rtpath)=@_;
my $ech=$e->{children};
my $ne={};
$ne->{children}=[];
$ne->{nodename}=$e->{nodename};
$ne->{nodedata}='';
my $ce=$rtpath->[0];
push @{$ce->{children}}, $ne;
unshift @{$rtpath},$ne;
my $varnum=0;
	for my $child (@{$ech})
	{	if($child->{nodename} eq 'text()')
		{push @{$ne->{children}},$child;}
		elsif($child->{nodename}=~/^@/){
			my $avalue=attr_value($child,$stpath,$rtpath);
			push @{$ne->{children}},newnode($child->{nodename},$avalue);}
		else
		{if($child->{nodename}!~/^xsl\:/){eval_element($child,$stpath,$rtpath);}
		 else{$varnum=$varnum+eval_instruction($child,$stpath,$rtpath);};};
	};
shift @{$rtpath};
while($varnum>0){shift @local_vars_names;shift @local_vars_values;$varnum--;};
}
eval_exprdescriptionprevnextTop
sub eval_expr {
my ($expr,$stpath,$type)=@_;
   if(ref($expr))
	{ my $op=$expr->{opname};
         if($op eq '#'){my $nodeset=[];node_seq($expr->{right},$stpath,$nodeset);
          return convert_nodeset($type,$nodeset);
		 }
		 elsif($op eq '/'){my $nodeset=[];node_seq_from_root($expr->{right},$stpath,$nodeset);
          return convert_nodeset($type,$nodeset);
		 }
         elsif($op eq '$'){return var_value($expr,$stpath,$type);}
		 elsif($op eq '|'){return xsl_union($expr,$stpath,$type);}
		 elsif($op eq '='){return is_equal($expr,$stpath);}
		 elsif($op eq '!=')
			 {my $eq=is_equal($expr,$stpath);if($eq){return 0;}else{return 1;};}
         elsif($op eq '>'){return n_comparison($expr,$stpath,$op);}
		 elsif($op eq '<'){return n_comparison($expr,$stpath,$op);}
		 elsif($op eq '<='){return n_comparison($expr,$stpath,$op);}
		 elsif($op eq '>='){return n_comparison($expr,$stpath,$op);}
		 elsif($op eq 'and')
			 {my $r=eval_expr($expr->{left},$stpath,0);
		                    if(!$r){return 0;}
							else{$r=eval_expr($expr->{right},$stpath,0);
							if($r){return 1;}else{return 0;};};
		     }
		 elsif($op eq 'or')
			 {my $r=eval_expr($expr->{left},$stpath,0);
		                    if($r){return 1;}
							else{$r=eval_expr($expr->{right},$stpath,0);
							if($r){return 1;}else{return 0;};};
		     }
		 elsif($op eq 'false'){return 0;}
		 elsif($op eq 'true'){return 1;}
		 elsif($op eq 'not')
			 {my $r=eval_expr($expr->{right},$stpath,0);
		      if($r){return 0;}else{return 1;};}
		 elsif($op eq 'boolean')
			 {my $r=eval_expr($expr->{right},$stpath,0);
		      if($r){return 1;}else{return 0;};}
         elsif($op eq 'contains')
		     {my $str1=eval_expr($expr->{left},$stpath,1);
		      my $str2=eval_expr($expr->{right},$stpath,1);
		      $str2=~s/(\W)/\\$1/gs;
if($str1=~/$str2/s){return 1;} else{return 0;}; } elsif($op eq 'starts-with') {my $str1=eval_expr($expr->{left},$stpath,1); my $str2=eval_expr($expr->{right},$stpath,1); $str2=~s/(\W)/\\$1/gs;
if($str1=~/^$str2/s){return 1;} else{return 0;}; } elsif($op eq 'key') {my $nodeset=eval_key_func($expr,$stpath); return convert_nodeset($type,$nodeset);} elsif($op eq 'position'){if($_index_){return $_index_}else{return $_position_;};} elsif($op eq 'last') { if($_index_){return $_last_node_;} else {if($_last_){return $_last_;}else{$_last_=$#{$_focus_}+1;return $_last_;}; }; } elsif($op eq 'count') {my $node_paths=eval_expr($expr->{right},$stpath,2); if(ref($node_paths)) {my $i=$#{$node_paths}; $i++; return $i;} else{return 0;}; } elsif($op eq 'current') {my $cstpath=$_focus_->[$_position_-1]; if($expr->{right}){return eval_expr($expr->{right},$cstpath,$type);}; if($type==1){return node_text($cstpath->[0]);} elsif($type==2){my $path=[@{$cstpath}];return [$path];} else{return 1;}; } elsif($op eq 'normalize-space') { if(defined($expr->{right})){return norm_space(eval_expr($expr->{right},$stpath,1));} else{return norm_space(node_text($stpath->[0]));}; } elsif($op eq 'save-file'){return save_upload_file($expr,$stpath);} elsif($op eq 'file-name') {if($expr->{right}){my $name=eval_expr($expr->{right},$stpath,1); if($name=~/[\\\/\:]?([\w\-\.]+)$/){return $1;}else{return ''}; }else{return '';} } elsif($op eq 'string'){return eval_expr($expr->{right},$stpath,1);} elsif($op eq 'string-length') {if(defined($expr->{right})){return length eval_expr($expr->{right},$stpath,1);} else{return length node_text($stpath->[0]);}; } elsif($op eq 'substring-after') {my $str1=eval_expr($expr->{left},$stpath,1); my $str2=eval_expr($expr->{right},$stpath,1); $str2=~s/(\W)/\\$1/gs;
if($str1=~/^(.*?)$str2(.*)/s){return $2;} else{return '';}; } elsif($op eq 'substring-before') {my $str1=eval_expr($expr->{left},$stpath,1); my $str2=eval_expr($expr->{right},$stpath,1); $str2=~s/(\W)/\\$1/gs;
if($str1=~/^(.*?)$str2/s){return $1;} else{return $str1;}; } elsif($op eq 'substring') {my $str=eval_expr($expr->{left},$stpath,1); my $n1=eval_expr($expr->{right},$stpath,1); if($expr->{param} ne '') {my $n2=eval_expr($expr->{param},$stpath,1); return substr($str,$n1-1,$n2);} else{return substr($str,$n1-1);}; } elsif($op eq 'translate') {my $str=eval_expr($expr->{left},$stpath,1); my $rlist=eval_expr($expr->{right},$stpath,1); my $slist=eval_expr($expr->{param},$stpath,1); $rlist=~s/(\W)/\\$1/gs;
$slist=~s/(\W)/\\$1/gs;
eval "\$str=\~tr\/$rlist\/$slist\/d"; # if($@){print "translate error $@\n";};
return $str; } elsif($op eq 'concat') {my $str=eval_expr($expr->{right},$stpath,1); my $args=$expr->{param}; for my $arg (@{$args}){my $addstr=eval_expr($arg,$stpath,1); $str.=$addstr;}; return $str; } elsif($op eq 'document') {return xsl_document($expr,$stpath,$type); } elsif($op eq '-') {my $l=eval_expr($expr->{left},$stpath,1); my $r=eval_expr($expr->{right},$stpath,1); return $l - $r; } elsif($op eq '+') {my $l=eval_expr($expr->{left},$stpath,1); my $r=eval_expr($expr->{right},$stpath,1); return $l + $r; } elsif($op eq '*') {my $l=eval_expr($expr->{left},$stpath,1); my $r=eval_expr($expr->{right},$stpath,1); return $l * $r; } elsif($op eq 'div') {my $l=eval_expr($expr->{left},$stpath,1); my $r=eval_expr($expr->{right},$stpath,1); return $l / $r;
} elsif($op eq 'number'){my $d=eval_expr($expr->{right},$stpath,1); if($d=~/$_is_number/){return $d;}else{return 'NaN';};} elsif($op eq 'sum') {my $ns=eval_expr($expr->{right},$stpath,2); if(ref($ns)) {my $sum=0; for my $n (@{$ns}){$sum+=node_text($n->[0]);}; return $sum; }else{if($ns=~/$_is_number/){return $ns}else{return 'NaN';}}; } elsif($op eq 'mod') {my $l=eval_expr($expr->{left},$stpath,1); my $r=eval_expr($expr->{right},$stpath,1); return $l % $r; } elsif($op eq 'name') {my $node=$stpath->[0]; if($expr->{right}){my $nset=eval_expr($expr->{right},$stpath,2); if(ref($nset)&&($nset->[0])){$node=$nset->[0]->[0];}else{return '';}; }; my $name=$node->{nodename}; if($name eq 'text()'){return '';} elsif($name=~/^@/){return substr($name,1);} else{return $name;}; } elsif($op eq 'system-property'){ my $sprop=eval_expr($expr->{right},$stpath,1); if($sprop and defined($ENV{$sprop})){return $ENV{$sprop};}else{return '';}; } elsif($op eq 'time'){return time();} elsif($op eq 'gmtime'){ my $t=0; if($expr->{left}){$t=eval_expr($expr->{left},$stpath,1);} else{$t=time();}; return gmt_time($t,$expr,$type); } else{}; } else { return $expr;}; } my $_default_template={'nodename'=>'xsl:apply_templates','nodedata'=>'','children'=>[], 'attslist'=>{'cselect'=>$_default_path_expr,'select'=>'node()','mode'=>'no','nparams'=>0}};
}
eval_instructiondescriptionprevnextTop
sub eval_instruction {
my ($instr,$stpath,$rtpath)=@_;
my $iname=$instr->{nodename};
  if($iname eq 'xsl:apply-templates'){
	  &apply_templates;}
  elsif($iname eq 'xsl:value-of'){
	  &value_of;}
  elsif($iname eq 'xsl:for-each'){
	  &for_each;}
  elsif($iname eq 'xsl:choose'){
	  &choose;}
  elsif($iname eq 'xsl:copy-of'){
	  &xsl_copy_of;}
  elsif($iname eq 'xsl:if'){
	  &xsl_if;}
  elsif($iname eq 'xsl:text'){
	  &xsl_text;}
  elsif($iname eq 'xsl:call-template'){
	  &xsl_call_template;}
  elsif($iname eq 'xsl:copy'){
      &xsl_copy;}
  elsif($iname eq 'xsl:variable'){
	  &xsl_var;return 1;}
  elsif($iname eq 'xsl:param'){
      return &xsl_param;}
  elsif($iname eq 'xsl:element'){
	  &xsl_element;}
  elsif($iname eq 'xsl:attribute'){
	  &xsl_attribute;}
  elsif($iname eq 'xsl:message'){
	  &xsl_message;}
  elsif($iname eq 'xsl:number'){
	  &xsl_number;}
  elsif($iname eq 'xsl:comment'){
	  &xsl_comment;}
  else{
  };
  return 0;
}
eval_key_funcdescriptionprevnextTop
sub eval_key_func {
	my ($expr,$stpath)=@_;
        my $k_name=eval_expr($expr->{left},$stpath,1);
        my $key=$stylesheet_keys{$k_name};
	    if(!$key){$key=install_key($k_name,$stpath);};
		my $rstr=eval_expr($expr->{right},$stpath,1);
		my $nset=$key->{$rstr};
		     if($nset)
				 {if($expr->{param})
					{my $ns=[];
			         my $pexpr=$expr->{param};
					 for my $path (@{$nset})
					  {node_seq($pexpr->{right},$path,$ns);};
                       $nset=$ns;
					};
                  return $nset;
				 }
		     else{return [];};
}
eval_templatedescriptionprevnextTop
sub eval_template {
my ($t,$stpath,$rtpath)=@_;
my $tch=$t->{children};
my $size=$#{$tch};
my $varnum=0;
	for (my $k=$t->{attsnumb};$k<=$size;$k++)
	{	my $tchild=$tch->[$k];
		if($tchild->{nodename}!~/^xsl\:/)
		{ if(defined($tchild->{attsnumb}))
		  {eval_element($tchild,$stpath,$rtpath);}
		  else
		  {my $sn=$rtpath->[0];push @{$sn->{children}},$tchild;};
		}
		else
		{$varnum=$varnum+eval_instruction($tchild,$stpath,$rtpath);};
	};
while($varnum>0){shift @local_vars_names;shift @local_vars_values;$varnum--;};
}
exiting_codedescriptionprevnextTop
sub exiting_code {
####################################################{
my $error=shift; $_xpath_expr_error_.=$error; if($xsltp_error_message){ error_log($_xpath_expr_error_); my $error_el=$xsltp_error_message;$xsltp_error_message=undef; my $e_xml=newnode('/',''); $e_xml->{attsnumb}=0; my $xml=newnode('/',''); $xml->{attsnumb}=0; my $start_source_path=[$xml]; my $error_path=[$e_xml]; eval_template($error_el,$start_source_path,$error_path); print_output($e_xml); exit; } else{print_error($_xpath_expr_error_);};
}
extract_sortdescriptionprevnextTop
sub extract_sort {
my $instr=shift; 
forloop:for my $ch (@{$instr->{children}})
	{if($ch->{nodename}=~/^xsl\:/)
		{if($ch->{nodename} eq 'xsl:sort')
			{
		     if(!defined($instr->{'sort'})){$instr->{'sort'}=[];};
	         push @{$instr->{'sort'}}, init_sort($ch);
			}
         else{last forloop;};
		};
	};
}
file_namedescriptionprevnextTop
sub file_name {
my ($base,$file)=@_;
#the following code from XML::Parser package of 
#Larry Wall and Clark Cooper is what we need here
my $newfile=$file; if ($base and not ($file =~ m!^(?:[\\/]|\w+:)!))
{
$newfile = $base;
$newfile =~ s![^\\/:]*$!$file!; }; if (is_file_name_notsafe($newfile)) { error_log("File ($newfile) contains Perl IO control characters\n"); exiting_code("File heandling error\n"); } return $newfile; } my $CHARS_MODEL='';
}
filter_node_seqdescriptionprevnextTop
sub filter_node_seq {
	my ($tseq,$cond)=@_;
	my $ret=[];
	for my $c (@{$cond})
	{if($c>0){my $npath=$tseq->[$c-1];if($npath){push @{$ret},$npath;};}
	 else
		{my $expr=$compiled_expresions[-$c];
	     my $lastnode=$#{$tseq}+1;
	     for (my $idx=0;$idx<$lastnode;$idx++) 
			{ my $path=$tseq->[$idx];
		      $_index_=$idx+1;
			  $_last_node_=$lastnode;
			  if(eval_expr($expr,$path,0)){push @{$ret},$path;};
			};
		};
    $tseq=$ret;$ret=[];
	};
	$_index_=0;
	return $tseq;
}
find_child_atdescriptionprevnextTop
sub find_child_at {
  my ($name,$cnode,$count,$start,$inc)=@_;
	  $count--;
	  my $chs=$cnode->{children};
	  my $i=$start; my $ch=$chs->[$i];
	  if($name eq '*')
		{ while($ch)
			{if(defined($ch->{attsnumb}))
		        {if($count==0){return $ch;};$count--;};
	         $i=$i+$inc;if($i>=0){$ch=$chs->[$i];}else{return undef;};
			};
		}
	  elsif($name eq 'node()')
		{ while($ch)
			{if($ch->{nodename}!~/^@/)
		        {if($count==0){return $ch;};$count--;};
	         $i=$i+$inc;if($i>=0){$ch=$chs->[$i];}else{return undef;};
			};
		}
	  else
		{ 
		  while($ch)
			{if($ch->{nodename} eq $name)
		        {if($count==0){return $ch;};$count--;};
	         $i=$i+$inc;if($i>=0){$ch=$chs->[$i];}else{return undef;};
			};
		};
     return undef;
};
}
find_child_positiondescriptionprevnextTop
sub find_child_position {
	my $path=shift;
	my $ch=$path->[0];
	my $p=$path->[1];
	my $i=0;
	if($p)
	{   my $ch0=$p->{children}->[$i];
		while($ch0!=$ch){$i++;$ch0=$p->{children}->[$i];
		                 if(!$ch0){return -1;};};
		return $i;
	}
	else{return -1;};
}
for_eachdescriptionprevnextTop
sub for_each {
	my ($instr,$stpath,$rtpath)=@_;
	my $code=$instr->{cselect};
	if(defined($code))
	{   push @_focus_stack_,$_focus_;
	    push @_count_stack_,$_position_;
	    my $node_paths=eval_expr($code,$stpath,2);
	    if($instr->{'sort'}){$node_paths=do_sort(0,$instr->{'sort'},$node_paths);};
	    $_focus_=$node_paths;
	    $_position_=0;
		$_last_=0;
		for my $path (@{$node_paths})
		{$_position_++;eval_template($instr,$path,$rtpath);};
		 $_focus_=pop @_focus_stack_;
	     $_position_=pop @_count_stack_;
		 $_last_=0;
	}
    else
	{  my $cexpr=compile_instr_attr_f($instr,'select');
	   if(is_expr_nodeset($cexpr))
			  {extract_sort($instr);for_each($instr,$stpath,$rtpath);}
	   else{my $sel=$instr->{attslist}->{'select'};
		    exiting_code("xsl:for\-each has invalid select attribute\n$sel\n");
	   };
	};
}
get_attr_valuedescriptionprevnextTop
sub get_attr_value {
my ($name,$el,$stpath,$rtpath)=@_;
 my $chs=$el->{children};
 my $aname='@';
 $aname.=$name;
 my $size=$el->{attsnumb};
 my $i=0;
 while($i<$size)
	{my $ch=$chs->[$i];
     if($ch->{nodename} eq $aname){return attr_value($ch,$stpath,$rtpath);};
     $i++;};
 return '';
}
get_var_valdescriptionprevnextTop
sub get_var_val {
my $expr=shift;
 my $name=$expr->{left};
	 my $i=-1;
	 for my $vname (@local_vars_names)
		 {$i++;if($vname eq $name){return $local_vars_values[$i];};};
if(defined($glob_vars{$name})){return $glob_vars{$name};}
else{exiting_code("unknown variable\" $name\"\n");};
}
gmt_timedescriptionprevnextTop
sub gmt_time {
 my ($t,$expr,$type)=@_;
if(($expr->{right}) or ($type==2))
	{my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday)=gmtime($t);
     my $root=newnode('/','');$root->{attsnumb}=0;
	 my $nyear=newnode('year','');$nyear->{attsnumb}=0;
	 push @{$nyear->{children}},newnode('text()',$year+1900);
	 push @{$root->{children}},$nyear;

	 my $nmonth=newnode('month','');$nmonth->{attsnumb}=0;
	 push @{$nmonth->{children}},newnode('text()',$mon+1);
	 push @{$root->{children}},$nmonth;

	 my $nday=newnode('day','');$nday->{attsnumb}=0;
	 push @{$nday->{children}},newnode('text()',$mday);
	 push @{$root->{children}},$nday;

	 my $nhour=newnode('hours','');$nhour->{attsnumb}=0;
	 push @{$nhour->{children}},newnode('text()',$hour);
	 push @{$root->{children}},$nhour;

	 my $nmin=newnode('minutes','');$nmin->{attsnumb}=0;
	 push @{$nmin->{children}},newnode('text()',$min);
	 push @{$root->{children}},$nmin;

	 my $nsec=newnode('seconds','');$nsec->{attsnumb}=0;
	 push @{$nsec->{children}},newnode('text()',$sec);
	 push @{$root->{children}},$nsec;

	 my $nwday=newnode('weekday','');$nwday->{attsnumb}=0;
	 push @{$nwday->{children}},newnode('text()',$wday+1);
	 push @{$root->{children}},$nwday;

	 my $nyday=newnode('yearday','');$nyday->{attsnumb}=0;
	 push @{$nyday->{children}},newnode('text()',$yday+1);
	 push @{$root->{children}},$nyday;

	 my $proot=[$root];
	 my $pexpr=$expr->{right};
	 if($pexpr){
		 my $nset=[];node_seq($pexpr->{right},$proot,$nset);
		 return convert_nodeset($type,$nset);
	 }
	 else{return [$proot];};
	}
else{my $st=gmtime($t);
     if($type){return $st;}
	 else{return 1;};
    };
}
groupdescriptionprevnextTop
sub group {
	my ($opened,$str,$gr,$groups)=@_;
	if($str=~/^(.*?)\((.+)/s)
	{ $gr.=$1;$gr.=' ';
	  my $strend=$2;
	  my $op2=$opened+1;
	  if($gr=~/(.*\)){$op2,}/s){$opened++; push @{$groups}, '';
	                            $gr='('.$gr;xpath_errors(1);$_fotal_error_='FOTALL ERROR';};
	  if(($gr=~/(.*\)){$opened}/s))
		{group_op($gr,$groups);
		    if($strend)
			{
             if($strend=~/.*\).*/s){group(1,$strend,'(',$groups);}
			 else{group(1,$strend.')','(',$groups);
				  xpath_errors(0);$_fotal_error_='FOTALL ERROR';};
		    };
		}
      else
		{my $nstr=$gr.$strend;
	     my $op=$opened+1;
		 if($nstr!~/(.*\)){$op,}/s)
	     {$strend.=')';xpath_errors(0);$_fotal_error_='FOTALL ERROR';};
	     $gr.='(';
		 $opened++;
		 group($opened,$strend,$gr,$groups);
		};
	}else{$gr.=$str;
	      my $op2=$opened+1; 
	      if($str=~/(.*\)){$op2,}/s){push @{$groups}, '';$gr='('.$gr;xpath_errors(1);$_fotal_error_='FOTALL ERROR';};
		  group_op($gr,$groups);};
}
group_opdescriptionprevnextTop
sub group_op {
	my $gr=shift;
	my $groups=shift;
		 if($gr=~/^\s*\(\s*(.*)\s*\)\s*(.*)/s)
		   {push @{$groups}, $1;if($2 ne ''){$gr=' '.$2;}else{$gr='';};};
		 while($gr ne '')
			{$gr=' '.$gr;  
			 if($gr=~/^\s*^(.*?)\s*(\sor\s|\sand\s|<=|>=|\!=|>|<|=|\+|\s\-\s|\smod\s|\sdiv\s|\*|,|\|)\s*(.*)\s*/s)
	            {$gr=$3;
			     my $op=$2; my $arg=$1;
			     $op=~s/^\s+//g;$op=~s/\s+$//g;
if($arg ne '') { if($op ne '*') {push @{$groups},$arg;} else {if($arg=~/(@|\:|\/)$/){$op=$arg.$op;} else{push @{$groups},$arg;} }; } if($op=~/\*$/) { if($gr=~/^\s*(\/|\[)/) {if($gr=~/^\s*^(.*?)\s*(\sor\s|\sand\s|<=|>=|\!=|>|<|=|\+|\s\-\s|\smod\s|\sdiv\s|\s\*\s|,|\|)\s*(.*)\s*/s) {$gr=$3;push @{$groups},$op.$1;$op=$2;$op=~s/^\s+//g;$op=~s/\s+$//g;}
else{
$gr=~s/^\s+//g;$gr=~s/\s+$//g;$op.=$gr;$gr='';};
}; }; push @{$groups},$op; } else{$gr=~s/^\s+//g;$gr=~s/\s+$//g;push @{$groups}, $gr;$gr='';};
};
}
has_preceding_nodedescriptionprevnextTop
sub has_preceding_node {
my ($stpath,$k,$els)=@_;
 my $cnode=$stpath->[$k];
 my $name=$cnode->{nodename};
 if($name ne '/')
	{ my $pcnode=$stpath->[$k+1];
      my $chs=$pcnode->{children};
	  for my $ch (@{$chs})
		  {for my $en (@{$els})
			  {
		       if($ch->{nodename} eq $en)
		       {if($ch!=$cnode){return 1;}else{return 0;};};
			  };
		  };
		  return 0;
	}else{return 0;};
}
initdescriptionprevnextTop
sub init {
$CHARS_MODEL='';
$stylesheet_prefix='';
$result_prefix='';
$_source_style='';
@_opened_stylesheets=();
$XML_BASE='';
$_xml_base_flag=0;
$XSLT_BASE='';
$MAX_CONTENT_SIZE=1024;
%template_modes=();
%template_names=();
%key_names=();
%stylesheet_keys=();
%XS_PARAMS=();
%glob_strings=();
%glob_objects=();
%glob_vars=();
@local_vars_values=();
@local_vars_names=();
$param_nums=0;
$output_indent='';
$output_method='';
$output_encoding='';
$omit_xmldecl='no';
$cgi_object=undef;
$xsltp_error_message=undef;
@_http_fields=();
@_http_contents=();
$_http_flag=1;
$_http_output=1;
@_focus_stack_=();
@_count_stack_=();
$_focus_=[];
$_position_=0;
$_last_=0;
$_index_=0;
$_last_node_=0;
$_xpath_expr_error_=undef;
$_fotal_error_=undef;
@compiled_expresions=(undef,$_default_path_expr);
$namber_of_exprs=2;
return\% XS_PARAMS;
}
init_loc_paramsdescriptionprevnextTop
sub init_loc_params {
my ($instr,$stpath)=@_;
 my $params=$instr->{params};
 my $npar=$instr->{nparams};
 while($npar>0){$npar--;my $p=$params->[$npar];
 my $name=$p->{attslist}->{name};
 my $expr=$p->{cselect};
 if($expr){unshift @local_vars_values,eval_expr($expr,$stpath,2);}
 else{unshift @local_vars_values,tree_fragment($p,$stpath);};
      unshift @local_vars_names,$name;
 };
}
init_sortdescriptionprevnextTop
sub init_sort {
my $sinstr=shift;
 my $select=$sinstr->{attslist}->{'select'};
 if(!$select){$sinstr->{attslist}->{'select'}='.';};
 compile_instr_attr_f($sinstr,'select');
 if(!($sinstr->{attslist}->{order})){$sinstr->{attslist}->{order}='ascending';};
 if(!($sinstr->{attslist}->{'data-type'})){$sinstr->{attslist}->{'data-type'}='text';};
return $sinstr;
}
install_expresiondescriptionprevnextTop
sub install_expresion {
	my $expr=shift;
	my @subexprs=split('\[',$expr);
	my $s=$#subexprs;
	my $i=1;
    my $subexpr=$subexprs[0];
	while($s>=$i)
	{ my $nsubex=$subexprs[$i];
	  my $op=1;
	    while($nsubex!~/(.*\].*){$op}/s)
		{$i++; $op++;
		 if($s>=$i) 
			 {$nsubex.='['; $nsubex.=$subexprs[$i];}
		 else{$_fotal_error_='FOTALL ERROR';xpath_errors(2);return 0;};
		};
		if($nsubex=~/(.+)\](.*?)$/s)
		{$nsubex=$1;
		 my $end=$2;
		 if($nsubex!~/^[0-9]+$/)
			 {$subexpr=join('',$subexpr,'[',install_expresion($nsubex),']',$end);}
		 else{
			 if($nsubex>=0)
			 {$subexpr=join('',$subexpr,'[',$nsubex,']',$end);}
			 else{$subexpr.=$end;};
		     };
		}else{$_fotal_error_='FOTALL ERROR';xpath_errors(2);return 0;};
		 $i++;
	};
	my $ret=-$namber_of_exprs;
	push @compiled_expresions,compile_expr($subexpr);
	if(!$_fotal_error_)
	{$namber_of_exprs++;return $ret;}
	else{return 0;};
}
install_keydescriptionprevnextTop
sub install_key {
  my ($k_name,$stpath)=@_;
   my $k_el=$key_names{$k_name};
   if(!$k_el){exiting_code("no key with such a name=\"$k_name\"\n");};
   my $match=$k_el->{attslist}->{cmatch};
   if(defined($match)){exiting_code("illegal call of key function\" $k_name\"\n");};
   $match=compile_instr_attr_f($k_el,'match');
   if(not(is_expr_nodeset($match))){exiting_code("key function\" $k_name\" has invalid match attribute\n");};
   if($match->{opname} eq '|'){
    my $es=$match->{param};
    for my $e (@{$es}){pattern_to_expr($e);};
   }else{pattern_to_expr($match);};

   my $use=compile_instr_attr_f($k_el,'use');
   my $nodeset=eval_expr($match,$stpath,2);
   my $key={};

	push @_focus_stack_,$_focus_;
	push @_count_stack_,$_position_;
	$_focus_=$nodeset;
	$_position_=0;
   for my $path (@{$nodeset})
	   {  $_position_++;
	      my $ruse=eval_expr($use,$path,2);
		  if(ref($ruse))
		   {  for my $path2 (@{$ruse})
			  {my $str=node_text($path2->[0]);
		         if($str){if(!defined($key->{$str})){$key->{$str}=[$path];}
				          else{push @{$key->{$str}},$path;};};
		      };
		   }
          else
		   { 
		     if($ruse){if(!defined($key->{$ruse})){$key->{$ruse}=[$path];}
				       else{push @{$key->{$ruse}},$path;};
			   }
			 else
			   {
		         if(is_boolean($use)){if(!defined($key->{0})){$key->{0}=[$path];}
				           else{push @{$key->{0}},$path;};};
			   };
		   };
       };
	$_focus_=pop @_focus_stack_;
	$_position_=pop @_count_stack_;
	$_last_=0;
    $stylesheet_keys{$k_name}=$key;
	return $key;
}
install_stylesheetdescriptionprevnextTop
sub install_stylesheet {
	my ($style,$ts,$vars)=@_;
	my $ch=$style->{children};
	my $i=$#{$ch};
	while($i>=0)
	{my $name=$ch->[$i]->{nodename};
	    if($name eq 'xsl:template'){push @{$ts},$ch->[$i];}
		elsif($name eq 'xsl:key'){
			my $key=$ch->[$i];my $key_n=$key->{attslist}->{name};
		    if($key_n){if(!defined($key_names{$key_n})){$key_names{$key_n}=$key;}else{exiting_code("redefined key function name\" $key_n\"\n");};
			}else{exiting_code("xsl:key has no name attribute\n");};
		}
		elsif(($name eq 'xsl:include')||($name eq 'xsl:import')){
			my $incl=$ch->[$i];my $file=$incl->{attslist}->{'href'};
			if($file){
				for my $st (@_opened_stylesheets){if($st eq $file){goto end;};};
				my $old_base=$XSLT_BASE;
				my $incst=read_xsl_file($file);
                install_stylesheet($incst,$ts,$vars);
				$XSLT_BASE=$old_base;
				end: };
		}
		elsif($name eq 'xsl:variable'){push @{$vars},$ch->[$i];}
		elsif($name eq 'xsl:param'){set_glob_params($ch->[$i]);}
		elsif($name eq 'xsl:namespace-alias'){
        my $alias=$ch->[$i];my $stpre=$alias->{attslist}->{'stylesheet-prefix'};
		my $rpre=$alias->{attslist}->{'result-prefix'};
		if(not($stylesheet_prefix)){
			if($stpre){$stylesheet_prefix=$stpre;if($rpre){$result_prefix=$rpre;}else{$result_prefix='xsl';};};};
		}
		elsif($name eq 'xsl:output'){
        my $out=$ch->[$i];my $outparam=$out->{attslist}->{indent};
		 if($outparam eq 'yes'){$output_indent='yes';};
		 $outparam=$out->{attslist}->{method};
		 if($outparam){if(!$output_method){$output_method=$outparam;};};
		 $outparam=$out->{attslist}->{encoding};
		 if($outparam){if(!$output_encoding){$output_encoding=$outparam;};};
		 $outparam=$out->{attslist}->{'omit-xml-declaration'};
		 if($outparam){$omit_xmldecl=$outparam;};
		 $outparam=$out->{attslist}->{'omit-http-headers'};
		 if($outparam eq 'yes'){$_http_output=0;};
		}
		elsif($name eq 'xsltp:max-content-length'){
        my $add=$ch->[$i]->{attslist}->{'select'};
		if($add=~/^-?\d+$/){$MAX_CONTENT_SIZE+=$add;};
		}
		elsif($name eq 'xsltp:xml-base'){
		if(not($_xml_base_flag)){
		my $newbase=$ch->[$i]->{attslist}->{'select'};
		$newbase=~s/\s+//g;
if($newbase){$_xml_base_flag=1;$XML_BASE=$newbase;}; } else{exiting_code("more than one xsltp:xml\-base elements\n");}; } elsif($name eq 'xsltp:http-output'){ my $h=$ch->[$i]->{attslist}->{'name'};$h=lc($h);$h=ucfirst($h); if($h){unshift @_http_fields, $h;unshift @_http_contents,$ch->[$i];}; } elsif($name eq 'xsl:message'){if(!defined($xsltp_error_message)){$xsltp_error_message=$ch->[$i];};}; $i--; };
}
install_templatedescriptionprevnextTop
sub install_template {
my $template=shift;
my $match=$template->{attslist}->{match};
my $name=$template->{attslist}->{name};
my $mode=$template->{attslist}->{mode};
if(!$mode){$mode='no';};
my $t_keys=$template_modes{$mode};
if(!$t_keys){$t_keys={};$template_modes{$mode}=$t_keys;};
	if($match)
	{my @patterns=split('\|',$match);
	 for my $s (@patterns)
	 {if($s){
			 my $patern=$s;
			 my $cond=0;
			 if($patern=~/([^\[]+)\[(.+)\]\s*$/s){$patern=$1;$cond=$2;};
			  
			     if($cond!~/^\d+$/)
				  {$cond=parse_expresion($cond);
			       if($cond==0){
					   exiting_code("invalid predicate in pattern $match\n");
					   };
				  };
			      if($patern=~/(.*)node\(\)$/)
					  {my $newp=$1.'text()';
			           $newp=~s/node\(\)/\*/g;
$newp=~s/child\:\://g;
$newp=~s/\s+//g;
set_template_key($newp,$template,$t_keys,$cond);}; $patern=~s/node\(\)/\*/g;
$patern=~s/attribute\:\:/@/g;
$patern=~s/child\:\://g;
$patern=~s/\s+//g;
set_template_key($patern,$template,$t_keys,$cond); }; }; }; if($name) {if(!defined($template_names{$name})){$template_names{$name}=$template;}; };
}
install_templatesdescriptionprevnextTop
sub install_templates {
my $ts=shift;
 for my $t (@{$ts})
	{if(is_template_not_empty($t)){
	  if($output_indent){strip_st_spaces($t);}
	  else{strip_all_spaces($t);};};
     install_template($t);};
}
is_booleandescriptionprevnextTop
sub is_boolean {
	my $expr=shift;
	if(!ref($expr)){return 0;}
	else
	{my $op=$expr->{opname};
	 return $_xpath_boolean{$op};};
}
is_equaldescriptionprevnextTop
sub is_equal {
	my ($expr,$stpath)=@_;
	my $left=eval_expr($expr->{left},$stpath,2);
	my $right=eval_expr($expr->{right},$stpath,2);
	if(ref($left) && ref($right))
	{
		for my $rarg (@{$right})
			{my $rstr=node_text($rarg->[0]);
		       for my $larg (@{$left}) 
				   {my $lstr=node_text($larg->[0]);
				    if($rstr eq $lstr){return 1;};};
		    };
        return 0;
	}
	else
	{ my $scaler=undef;
	  my $nodeset=undef;
	  my $stype=undef;

	    if(ref($left)){$scaler=$right;$nodeset=$left;$stype=$expr->{right};}
	    elsif(ref($right)){$scaler=$left;$nodeset=$right;$stype=$expr->{left};}
	    else
		   {if(is_boolean($expr->{left})||is_boolean($expr->{right}))
			   {
			        if($right){$right=1;}else{$right=0;};
		            if($left){$left=1;}else{$left=0;};
			     if($right==$left){return 1;}else{return 0;};
			   }
             elsif(($right=~/$_is_number/)&&($left=~/$_is_number/))
			   {if($right==$left){return 1;}else{return 0;};}
			 else
			   {if($right eq $left){return 1;}else{return 0;};};
		   };

      if($scaler=~/$_is_number/)
		{ if(($scaler==0)||($scaler==1))
		  {
		    if(is_boolean($stype))
			{my $nb=$nodeset->[0]?1:0;
	         if($nb==$scaler){return 1;}
			 else{return 0;};};
		  };
          
		  for my $arg (@{$nodeset})
			{my $str=node_text($arg->[0]);
		     $str=~s/^\s+//g;
$str=~s/\s+$//g;
if($str && $str==$scaler){return 1;}; }; return 0; } else { for my $arg (@{$nodeset}) {my $str=node_text($arg->[0]); if($str eq $scaler){return 1;};}; return 0; }; };
}
is_expr_nodesetdescriptionprevnextTop
sub is_expr_nodeset {
my $cexpr=shift;
if(!ref($cexpr)){return 0;};
my $op=$cexpr->{opname};
if(($op eq '#')||($op eq '/')||($op eq 'key')||($op eq '|')||($op eq 'document')||($op eq 'gmtime'))
	{return 1;}
elsif($op eq '$')
	{if(ref(get_var_val($cexpr))){return 1;}else{return 0;};}
else{return 0;};
}
is_file_name_notsafedescriptionprevnextTop
sub is_file_name_notsafe {
my $name=shift;
  if ($name =~ /^\s*[|>+]/
      or $name =~ /\|\s*$/) {return 1;};
return 0;
}
is_template_not_emptydescriptionprevnextTop
sub is_template_not_empty {
 my $t=shift;
  my $tchs=$t->{children}; 
  my $size=$#{$tchs};
  if($size>0) {return 1;}
  elsif($size==0)
	{my $ch=$tchs->[0];
     if($ch->{nodename} eq 'text()'){if($ch->{nodedata}=~/^\s*$/){pop @{$tchs};};};
	 return 0;}
  else{return 0;};
}
n_comparisondescriptionprevnextTop
sub n_comparison {
	my ($expr,$stpath,$op)=@_;
	my $left=eval_expr($expr->{left},$stpath,2);
	my $right=eval_expr($expr->{right},$stpath,2);
	if(ref($left) && ref($right))
	{
		for my $rarg (@{$right})
			{my $rstr=node_text($rarg->[0]);$rstr=~s/^\s+//g;$rstr=~s/\s+$//g;
for my $larg (@{$left}) {my $lstr=node_text($larg->[0]);$lstr=~s/^\s+//g;$lstr=~s/\s+$//g;
if(($rstr=~/$_is_number/)&&($lstr=~/$_is_number/)) { if($op eq '>') {if($lstr>$rstr){return 1;};} elsif($op eq '>=') {if($lstr>=$rstr){return 1;};} elsif($op eq '<') {if($lstr<$rstr){return 1;};} else {if($lstr<=$rstr){return 1;};}; }; }; }; return 0; } else { if(ref($left)) {$right=~s/^\s+//g;$right=~s/\s+$//g;
if($right=~/$_is_number/) { for my $arg (@{$left}) {my $lstr=node_text($arg->[0]); $lstr=~s/^\s+//g;
$lstr=~s/\s+$//g;
if($lstr=~/$_is_number/) { if($op eq '>') {if($lstr>$right){return 1;};} elsif($op eq '>=') {if($lstr>=$right){return 1;};} elsif($op eq '<') {if($lstr<$right){return 1;};} else {if($lstr<=$right){return 1;};}; }; }; }; return 0; } elsif(ref($right)) {$left=~s/^\s+//g;$left=~s/\s+$//g;
if($left=~/$_is_number/) { for my $arg (@{$right}) {my $rstr=node_text($arg->[0]); $rstr=~s/^\s+//g;
$rstr=~s/\s+$//g;
if($rstr=~/$_is_number/) { if($op eq '>') {if($left>$rstr){return 1;};} elsif($op eq '>=') {if($left>=$rstr){return 1;};} elsif($op eq '<') {if($left<$rstr){return 1;};} else {if($left<=$rstr){return 1;};}; }; }; }; return 0; } else {$right=~s/^\s+//g;$right=~s/\s+$//g;
$left=~s/^\s+//g;$left=~s/\s+$//g;
if(($right=~/$_is_number/)&&($left=~/$_is_number/)) { if($op eq '>') {if($left>$right){return 1;};} elsif($op eq '>=') {if($left>=$right){return 1;};} elsif($op eq '<') {if($left<$right){return 1;};} else {if($left<=$right){return 1;};}; }; return 0; }; };
}
named_ancestorsdescriptionprevnextTop
sub named_ancestors {
  my ($name,$tselect,$newpath,$tseq)=@_;
					  my $c=$newpath->[0];
					  while($c)
						 {if($c->{nodename} eq $name)
							 {
						      my $tpath=[@{$newpath}];
						      node_seq($tselect,$newpath,$tseq);
						      shift @{$tpath};
						      $newpath=$tpath;
							 }
                          else{shift @{$newpath};};
						  $c=$newpath->[0];
						 };
}
newnodedescriptionprevnextTop
sub newnode {
   
my ($name, $data)=@_;
my $ret={};
$ret->{children}=[];
$ret->{nodename}=$name;
$ret->{nodedata}=$data;
return $ret;
};

my $_root=undef;
my $_source_style='';
my @_opened_stylesheets=();
}
node_seqdescriptionprevnextTop
sub node_seq {
	my ($select,$path,$seq)=@_;
	if($select)
	{  my $cnode=$path->[0];
		{  my $name=$select->{name};
		   my $cond=$select->{conds};
		   my $namepre=$select->{axis};
		   my $newselect=$select->{'next'};
		   my $tseq=[];
		   my $tselect=undef;
		   if(!$cond){$tselect=$newselect; $tseq=$seq;}
		   else{$cond=[@{$select->{conds}}];};
		   if($namepre>0)  
		   {		       
			   if($namepre==1)
			   {   if($newselect){if($name eq 'node()'){$name='*';};};
				   if($name eq '*')
					   {
					   if(defined($cnode->{attsnumb})){
						                            my $newpath=[@{$path}];
					                                node_seq($tselect,$newpath,$tseq);
													if($cnode->{children}->[0]){
													scanelemets($tselect,$newpath,$tseq);};
													};
					   }
				   elsif($name eq 'node()')
					   {
					    if($cnode->{nodename}!~/^@/){
						                            my $newpath=[@{$path}];
					                                node_seq($tselect,$newpath,$tseq);
													if($cnode->{children}->[0]){
													scannodes($tselect,$newpath,$tseq);};
													};
					   }
				   else
				       {
					   if($cnode->{nodename} eq $name){
						                            my $newpath=[@{$path}];
					                                node_seq($tselect,$newpath,$tseq);
													if($cnode->{children}->[0]){
												    scannames($name,$tselect,$newpath,$tseq);};
													  }
                                                  else{ 
													if($cnode->{children}->[0]){
												    scannames($name,$tselect,$path,$tseq);};
												      };
				       };
		       }
			   elsif($namepre==2)
			   {
				   if($name eq 'node()')
					   {
					   
						                            my $newpath=[@{$path}];
					                                node_seq($tselect,$newpath,$tseq);
					   }
				   elsif($name eq '*')
					   {
					   if(defined($cnode->{attsnumb})){
						                            my $newpath=[@{$path}];
					                                node_seq($tselect,$newpath,$tseq);
													};
					   }
				   else
				       {
					   if($cnode->{nodename} eq $name){
						                            my $newpath=[@{$path}];
					                                node_seq($tselect,$newpath,$tseq);
													};
				       };
			   }
			   elsif($namepre==3)
			   {my $pnode=$path->[1];
			    if($pnode)
				 {
				   if(($name eq 'node()')||($name eq '*'))
					   {
						  my $newpath=[@{$path}];
						  shift @{$newpath};
					      node_seq($tselect,$newpath,$tseq);
					   }
				   else
				       {
					   if($pnode->{nodename} eq $name)
					      {
						   my $newpath=[@{$path}];
						   shift @{$newpath};
					       node_seq($tselect,$newpath,$tseq);
				          };
					   };
				 };
			   }
			   elsif($namepre==4)
			   {   if($newselect){if($name eq 'node()'){$name='*';};};
			         if($cnode->{children}->[0])
				     {
				      if($name eq '*')
					   {scanelemets($tselect,$path,$tseq);}
				      elsif($name eq 'node()')
					   {scannodes($tselect,$path,$tseq);}
				      else
				       {scannames($name,$tselect,$path,$tseq);};
					 };
		       }
			   elsif($namepre==5)
			   {my $pos=find_child_position($path);
			      if($pos>0)
				   {
					  my $newpath=[@{$path}];shift @{$newpath};
					  $pos--;
			          if($cond)
			            {if($cond->[0]>0)
			              {my $num=shift @{$cond};
					        if(!defined($cond->[0]))
			                {$tselect=$newselect; $tseq=$seq;$cond=undef;};
				            my $node=find_child_at($name,$path->[1],$num,$pos,-1);
				            if($node){unshift @{$newpath},$node;
				                      node_seq($tselect,$newpath,$tseq);};
				            goto end;
				          };
			            };
					  my $chs=$newpath->[0]->{children};
					  if($name eq '*')
					  {  while($pos>=0)
						  {if(defined($chs->[$pos]->{attsnumb}))
							  {my $tpath=[$chs->[$pos],@{$newpath}];
					           node_seq($tselect,$tpath,$tseq);};
                           $pos--;
						  };
					  }
					  elsif($name eq 'node()')
					  {  while($pos>=0)
						  {if($chs->[$pos]->{nodename}!~/^@/)
							  {my $tpath=[$chs->[$pos],@{$newpath}];
					           node_seq($tselect,$tpath,$tseq);};
                           $pos--;
						  };
					  }
					  else
					  {  while($pos>=0)
						  {if($chs->[$pos]->{nodename} eq $name)
							  {my $tpath=[$chs->[$pos],@{$newpath}];
					           node_seq($tselect,$tpath,$tseq);};
                           $pos--;
						  };

					  };
				   };
			   }
			   elsif($namepre==6)
		       {my $pos=find_child_position($path);

				  if($pos>=0)
				   {
					  my $newpath=[@{$path}];shift @{$newpath};
                      $pos++;
			          if($cond)
			            {if($cond->[0]>0)
			              {my $num=shift @{$cond};
					        if(!defined($cond->[0])){$tselect=$newselect; $tseq=$seq;$cond=undef;};
				            my $node=find_child_at($name,$path->[1],$num,$pos,1);
				            if($node){unshift @{$newpath},$node;
				                      node_seq($tselect,$newpath,$tseq);};
				            goto end;
				          };
			            };
					  my $chs=$newpath->[0]->{children};
					  my $size=$#{$chs};
					  if($name eq '*')
					  {  while($pos<=$size)
						  {if(defined($chs->[$pos]->{attsnumb}))
							  {my $tpath=[$chs->[$pos],@{$newpath}];
					           node_seq($tselect,$tpath,$tseq);};
                           $pos++;
						  };
					  }
					  elsif($name eq 'node()')
					  {  while($pos<=$size)
						  {if($chs->[$pos]->{nodename}!~/^@/)
							  {my $tpath=[$chs->[$pos],@{$newpath}];
					           node_seq($tselect,$tpath,$tseq);};
                           $pos++;
						  };
					  }
					  else
					  {  while($pos<=$size)
						  {if($chs->[$pos]->{nodename} eq $name)
							  {my $tpath=[$chs->[$pos],@{$newpath}];
					           node_seq($tselect,$tpath,$tseq);};
                           $pos++;
						  };

					  };
				   };
			   }
			   elsif($namepre==7)
			   {  if($name eq 'node()'){$name='*';};
			         if($name eq '*')
				     {
					  my $newpath=[@{$path}];
					  shift @{$newpath};
                      ancestors($tselect,$newpath,$tseq);
					 }
					 else
				     {
					  my $newpath=[@{$path}];
					  shift @{$newpath};
					  named_ancestors($name,$tselect,$newpath,$tseq);
					 };
			   }
			   elsif($namepre==8)
			   {     if($name eq '*')
				     {
					  my $newpath=[@{$path}];
					  if(defined($cnode->{attsnumb}))
						 {my $tpath=[@{$newpath}];
					      node_seq($tselect,$tpath,$tseq);
						  shift @{$newpath};};
                      ancestors($tselect,$newpath,$tseq);
					 }
					 elsif($name eq 'node()')
				     {
					  my $newpath=[@{$path}];
					  if($cnode->{nodename}!~/^@/)
						 {my $tpath=[@{$newpath}];
					      node_seq($tselect,$tpath,$tseq);
						  shift @{$newpath};};
                      ancestors($tselect,$newpath,$tseq);
					 }
					 else
				     {
					  my $newpath=[@{$path}];
					  if($cnode->{nodename} eq $name)
						 {my $tpath=[@{$newpath}];
					      node_seq($tselect,$tpath,$tseq);
						  shift @{$newpath};};
					  named_ancestors($name,$tselect,$newpath,$tseq);
					 };
			   };
		   }else
		   { 
			   if($cond)
			   {if($cond->[0]>0)
			     {my $num=shift @{$cond};
					if(!defined($cond->[0])){$tselect=$newselect; $tseq=$seq;$cond=undef;};
				    if($name!~/^@/)
					 {
					  my $node=find_child_at($name,$cnode,$num,0,1);
				      if($node){my $newpath=[$node,@{$path}];
				                node_seq($tselect,$newpath,$tseq);};
					 };
				     goto end;
				 };
			   };
			   
			   if($name eq '*')
			   {
		        for my $child (@{$cnode->{children}})
			    {
			     if(defined($child->{attsnumb}))
				 {
				   my $newpath=[$child,@{$path}];
				   node_seq($tselect,$newpath,$tseq);
				 };
				};
			   }
			   elsif($name eq '@*')
			   {my $i=$cnode->{attsnumb};
			      if($i)
				  {
					  for (my $k=0;$k<$i ;$k++) {
						  my $newpath=[@{$path}];
						  unshift @{$newpath},$cnode->{children}->[$k];
						  node_seq($tselect,$newpath,$tseq);
					  };
				  };
			   }
			   elsif($name eq 'node()')
			   {
		        for my $child (@{$cnode->{children}})
			    {
			     if($child->{nodename}!~/^@/)
				 {
				   my $newpath=[$child,@{$path}];
				   node_seq($tselect,$newpath,$tseq);
				 };
				};
			   }
			   else
			   {
		        for my $child (@{$cnode->{children}})
			    {
			     if($child->{nodename} eq $name)
				 {
				   my $newpath=[$child,@{$path}];
				   node_seq($tselect,$newpath,$tseq);
				 };
			    };
			   };
		   };
           end:
		   if($cond){
                $tseq=filter_node_seq($tseq,$cond);
		   for my $np (@{$tseq}){node_seq($newselect,$np,$seq);};
		   };
		};
									   
	}
	else{push @{$seq}, $path;};
}
node_seq_from_rootdescriptionprevnextTop
sub node_seq_from_root {
	my ($select,$path,$seq)=@_;
		  my $last=$#{$path};
	      my $root=$path->[$last];
          my $npath=[$root];
		  node_seq($select,$npath,$seq);
}
node_set_to_strdescriptionprevnextTop
sub node_set_to_str {
	my $nodeset=shift;
		if($nodeset->[0])
		{ my $snode=$nodeset->[0]->[0];
		  return node_text($snode);
		}else{return '';};
}
node_textdescriptionprevnextTop
sub node_text {
	my $node=shift;
	my $str=$node->{nodedata};
	if(!$str)
	{
		for my $ch (@{$node->{children}})
		{if($ch->{nodename}!~/^@/){$str.=node_text($ch);};};
	};
	return $str;
}
norm_spacedescriptionprevnextTop
sub norm_space {
	my $str=shift;
	$str=~s/^\s+//g;
$str=~s/\s+$//g;
$str=~s/\s+/ /g;
return $str; };
}
op_codedescriptionprevnextTop
sub op_code {
    my $op=shift;
	if($op eq '|'){return 8;}
	elsif($op eq 'div'){return 7;}
	elsif($op eq '*'){return 7;}
	elsif($op eq 'mod'){return 7;}
	elsif($op eq '+'){return 6;}
	elsif($op eq '-'){return 6;}
	elsif($op eq '!='){return 4;}
	elsif($op eq '='){return 4;}
	elsif($op eq '>'){return 5;}
	elsif($op eq '<'){return 5;}
	elsif($op eq '>='){return 5;}
	elsif($op eq '<='){return 5;}
	elsif($op eq 'and'){return 3;}
	elsif($op eq 'or'){return 2;}
	elsif($op eq ','){return 1;}
    else{return 0;};
}
parse_expresiondescriptionprevnextTop
sub parse_expresion {
my $expr=shift;
my $oexpr=$expr;
if($expr=~/\$/s)
	{my @vnames=keys %glob_objects;
     for my $vname (@vnames)
		 {$expr=~s/\$$vname(\W)/$glob_objects{$vname}$1/gs;
$expr=~s/\$$vname$/$glob_objects{$vname}/;};
}; @literal_replace=(); my $i=-1; $expr=~s/(\'|\")(.*?)\1/push @literal_replace,$2;$i++;"\'$i\'"/egs;
$expr=~s/node\s*\(\s*\)/\&\%1 /gs;
$expr=~s/text\s*\(\s*\)/\&\%2 /gs;
$expr=~s/comment\s*\(\s*\)/\&\%3 /gs;
$expr=~s/processing\-instruction\s*\(\s*\)/\&\%4 /gs;
my $ret=install_expresion($expr); @literal_replace=undef; if($ret==0){$_xpath_expr_error_.=$oexpr;$_xpath_expr_error_.="\n";}; return $ret; } #################################### end xpath #########################
}
parse_step_patterndescriptionprevnextTop
sub parse_step_pattern {
my $str=shift;
 my $name='';
 my $cond='';
 my $newstr='';
if($str=~/^\/([@\w\.\:\-\(\)\*]+)(\[[\-\d\[\]]+\])?(\/.+)/)
	{$name=$1;$cond=$2;$newstr=$3;}
elsif($str=~/^\/([@\w\.\:\-\(\)\*]+)(\[[\-\d\[\]]+\])?/)
	{$name=$1;$cond=$2;}
else{$_fotal_error_='ERROR';xpath_errors(8);return undef;};
     if($name eq '.'){$name='self::node()';};
	 my $h={};
	 if($cond){$h->{conds}=conditions_array($cond);};
	 if($name=~/^([\w\-]+)\:\:([\w\.\:\-\*\(\)]+)/)
		{my $namepre=$1;$name=$2;
	     my $acode=$_axis_code{$namepre};
		 if($acode){$h->{axis}=$acode;$h->{name}=$name;}
		 else{$_fotal_error_='ERROR';xpath_errors(8);$_xpath_expr_error_.="unknown axis\" $namepre\"\n";return undef;};
		}
     else
		{$h->{axis}=0;$h->{name}=$name;};
	 if($newstr){$h->{'next'}=parse_step_pattern($newstr);};
	 return $h;
}
pattern_to_exprdescriptionprevnextTop
sub pattern_to_expr {
my $p=shift;
 if($p->{opname} eq '#')
	{
	   my $h={};$h->{axis}=1;$h->{name}='node()';
	   $h->{'next'}=$p->{right};
	   $p->{opname}='/';
	   $p->{right}=$h;
	};
}
prepare_pathdescriptionprevnextTop
sub prepare_path {
my $str=shift;
$str=~s/^\s*//g;
$str=~s/\s*$//g;
if($str=~/^\'(.*)\'$/) {return $literal_replace[$1];} else { $str=~s/\s+//gs;
if($str=~/$_is_number/) {return $str;} else { $str=~s/\&\%1/node\(\)/g;
$str=~s/\&\%2/text\(\)/g;
$str=~s/\&\%3/comment\(\)/g;
$str=~s/\&\%4/processing\-instruction\(\)/g;
$str=~s/child\:\://g;
$str=~s/attribute\:\:/@/g;
$str=~s/\.\./parent\:\:node\(\)/g;
$str=~s/\/\//\/descendant\-or\-self\:\:node\(\)\//g;
return prepare_var_expr($str); }; };
}
prepare_step_pathdescriptionprevnextTop
sub prepare_step_path {
my $str=shift;
 my $h={};
 if($str!~/^\//){$h->{opname}='#';$str=join('','/',$str);$h->{right}=parse_step_pattern($str);}
 else{$h->{opname}='/';
 if($str ne '/'){$h->{right}=parse_step_pattern($str);}
 else{my $hr={};$hr->{axis}=2;$hr->{name}='/';$h->{right}=$hr;};};
return $h;
}
prepare_var_exprdescriptionprevnextTop
sub prepare_var_expr {
my $str=shift;
    if($str=~/^\$(.+)/)
	{if(defined($glob_strings{$1})){return $glob_strings{$1};}
	 else
	  {my $vn=$1;
	   my $he={};$he->{opname}='$';
	   if($vn=~/^[\w\.\:\-]+$/){$he->{left}=$vn;}
	   elsif($vn=~/^([\w\.\:\-]+)(\[[\d\-\[\]]+\])\/(.+)/){$he->{left}=$1;$he->{conds}=conditions_array($2);$he->{right}=prepare_step_path($3);}
	   elsif($vn=~/^([\w\.\:\-]+)\/(.+)/){$he->{left}=$1;$he->{right}=prepare_step_path($2);}
	   elsif($vn=~/^([\w\.\:\-]+)(\[[\d\-\[\]]+\])/){$he->{left}=$1;$he->{conds}=conditions_array($2);}
	   else{exiting_code("invalid variable name\" $vn\"\n");};
	   return $he;
	  };
	}else{return prepare_step_path($str);};
}
print_docdescriptionprevnextTop
sub print_doc {
	my $node=shift;
	my $str=shift;
	my $rch=$node->{children};
	if(($output_method eq 'xml') and ($omit_xmldecl eq 'no')){$$str.='<?xml version="1.0"';
	  if($output_encoding){$$str.=' encoding=';$$str.="\"$output_encoding\"";};
	  $$str.='?>';
	};
	for my $ch (@{$rch})
	{if($ch->{nodename} eq 'xml-document'){save_to_file($ch);}
	 else{print_with_method($output_method,$ch,$str);}};
}
print_errordescriptionprevnextTop
sub print_error {
my $err=shift;
if($_http_output)
	{print "Content-type:text/html\n\n",'<html><body>',$err,'</body></html>';}
else{print $err;};
exit;
}
print_http_headersdescriptionprevnextTop
sub print_http_headers {
if($_http_output)
{
 my %https=();
 for (my $i=0;$i<=$#_http_fields;$i++) {
 if($_http_contents[$i]){
	 if(not($https{$_http_fields[$i]})){
		 print $_http_fields[$i],':',$_http_contents[$i],"\n";
         $https{$_http_fields[$i]}=1;
	 };
 };
 };
 if($https{'Content-type'}){print "\n";}
 else{
	#print "Content-type:text/html\n\n";
}; };
}
print_outputdescriptionprevnextTop
sub print_output {
my $result_tree=shift;
my $output_str='';
print_doc($result_tree,\$output_str);
if($_http_flag){print_http_headers();$_http_flag=0;
if($CHARS_MODEL eq 'bytes'){binmode(STDOUT);}
else{
	if($] > 5.007){binmode(STDOUT,":utf8");};
	};
	           };

#print $output_str;
return $output_str;
}
print_tree_htmldescriptionprevnextTop
sub print_tree_html {
#############################################{
my $node=shift; my $str=shift; my $rch=$node->{children}; $$str.='<'; $$str.=$node->{nodename}; my $size=$#{$rch}; my $ai=-1; FOR:for(my $i=0;$i<=$size;$i++) { my $ch=$rch->[$i]; if($ch->{nodename}=~/^@/) { $ai++; $$str.=' '; my $aname=substr($ch->{nodename},1); $$str.=$aname; my $astr=$ch->{nodedata}; if($aname ne $astr) {$$str.='="'; if(($aname ne 'href') and ($aname ne 'HREF')) { if($astr!~/\&\{/){$astr=~s/\&/\&amp;/g;};
}; $astr=~s/>/\&gt;/sg;
$astr=~s/\"/\&quot;/sg;
$astr=~s/\xA0/\&nbsp;/sg;
$$str.=$astr; $$str.='"'; }; } else{last FOR;} }; if($ai==$size) { my $nname=lc($node->{nodename});$$str.='>'; if(not($_html_empty{$nname})){$$str.=join('','</',$node->{nodename},'>');}; } else { $$str.='>'; $ai++; if($_html_codes_el{$node->{nodename}}) {for(my $k=$ai;$k<=$size;$k++) {my $ch=$rch->[$k];if($ch->{nodename} eq 'text()'){$$str.=$ch->{nodedata};};}; goto endel;}; for(my $k=$ai;$k<=$size;$k++) { my $ch=$rch->[$k]; if($ch->{nodename} eq 'text()') {if($ch->{noe}){$$str.=$ch->{nodedata};} else{ my $nstr=$ch->{nodedata}; $nstr=~s/\&/\&amp;/gs;
$nstr=~s/</\&lt;/gs;
$nstr=~s/>/\&gt;/gs;
$nstr=~s/\"/\&quot;/gs;
$nstr=~s/\xA0/\&nbsp;/gs;
$$str.=$nstr;}; } elsif($ch->{nodename} eq 'comment()') {$$str.=join('','<!--',$ch->{nodedata},'-->');} else {print_tree_html($ch,$str);}; }; endel: $$str.=join('','</',$node->{nodename},'>'); }; } my $stylesheet_prefix=''; my $result_prefix='';
}
print_tree_textdescriptionprevnextTop
sub print_tree_text {
	my $node=shift;
	my $str=shift;
	my $rch=$node->{children};
	$$str.='<';
	$$str.=$node->{nodename};
	my $size=$#{$rch};
	my $ai=-1;
FOR:for(my $i=0;$i<=$size;$i++)
	{   my $ch=$rch->[$i]; 
		if($ch->{nodename}=~/^@/)
			{
             $ai++;
	         $$str.=join('',' ',substr($ch->{nodename},1),'=',"\"",$ch->{nodedata},"\"");
			}
		else{last FOR;}
	};
    if($ai==$size){$$str.='/>';}
	else
	{ $$str.='>';
	  $ai++; 
      for(my $k=$ai;$k<=$size;$k++)
		{
		   my $ch=$rch->[$k];
		   if($ch->{nodename} eq 'text()')
		     {$$str.=$ch->{nodedata};}
		   elsif($ch->{nodename} eq 'comment()')
			 {$$str.=join('','<!--',$ch->{nodedata},'-->');} 
		   else
		     {print_tree_text($ch,$str);};
		};
      $$str.=join('','</',$node->{nodename},'>');
	};
}
my %_html_empty=('area'=>1,'base'=>1,'basefont'=>1, 'br'=>1, 'col'=>1, 
'frame'=>1, 'hr'=>1, 'img'=>1, 'input'=>1, 'isindex'=>1, 'link'=>1, 'meta'=>1,'param'=>1,
'colgroup'=>1, 'dd'=>1, 'dt'=>1, 'li'=>1, 'option'=>1, 'p'=>1, 'td'=>1, 'tfoot'=>1, 'th'=>1,'thead'=>1,'tr'=>1);
my %_html_codes_el=('script'=>1,'SCRIPT'=>1,'Script'=>1,
'style'=>1,'STYLE'=>1,'Style'=>1);
}
print_tree_xmldescriptionprevnextTop
sub print_tree_xml {
#############################################{
my $node=shift; my $str=shift; my $rch=$node->{children}; $$str.='<'; my $nn=$node->{nodename}; if(not($stylesheet_prefix)){$$str.=$nn;} else{$nn=~s/^$stylesheet_prefix\:/$result_prefix\:/;$$str.=$nn;};
my $size=$#{$rch}; my $ai=-1; FOR:for(my $i=0;$i<=$size;$i++) { my $ch=$rch->[$i]; if($ch->{nodename}=~/^@/) { $ai++; $$str.=' '; my $aname=substr($ch->{nodename},1); $$str.=$aname; my $astr=$ch->{nodedata}; $$str.='="'; $astr=~s/\&/\&amp;/gs;
$astr=~s/</\&lt;/gs;
$astr=~s/>/\&gt;/gs;
$astr=~s/\"/\&quot;/gs;
$$str.=$astr; $$str.='"'; } else{last FOR;} }; if($ai==$size) { $$str.='/>'; } else { $$str.='>'; $ai++; for(my $k=$ai;$k<=$size;$k++) { my $ch=$rch->[$k]; if($ch->{nodename} eq 'text()') {if($ch->{noe}){$$str.=$ch->{nodedata};} else{ my $nstr=$ch->{nodedata}; $nstr=~s/\&/\&amp;/gs;
$nstr=~s/</\&lt;/gs;
$nstr=~s/>/\&gt;/gs;
$nstr=~s/\"/\&quot;/gs;
$$str.=$nstr;}; } elsif($ch->{nodename} eq 'comment()') {$$str.=join('','<!--',$ch->{nodedata},'-->');} else {print_tree_xml($ch,$str);}; }; $$str.=join('','</',$nn,'>'); }; } ########### stylesheet parameters ##################################
my %template_modes=(); my %template_names=(); my %key_names=(); my %stylesheet_keys=(); my %XS_PARAMS=(); my %glob_strings=(); my %glob_objects=(); my %glob_vars=(); my @local_vars_values=(); my @local_vars_names=(); my $param_nums=0; my $output_indent=''; my $output_method=''; my $output_encoding=''; my $omit_xmldecl='no'; my $cgi_object=undef; my $xsltp_error_message=undef; my @_http_fields=(); my @_http_contents=(); my $_http_flag=1; my $_http_output=1;
}
print_with_methoddescriptionprevnextTop
sub print_with_method {
my ($metod,$ch,$str)=@_;
		   if($ch->{nodename} eq 'text()')
		     {$$str.=$ch->{nodedata};}
		   elsif($ch->{nodename} eq 'comment()')
			 {$$str.=join('','<!--',$ch->{nodedata},'-->');}
		   else
		     {if($metod eq 'xml'){print_tree_xml($ch,$str);}
		      elsif($metod eq 'html'){print_tree_html($ch,$str);}
		      elsif($metod eq 'text'){print_tree_text($ch,$str);}
			  else
				 {my $nname=$ch->{nodename};
				  if(($nname eq 'html') or ($nname eq 'HTML')){print_tree_html($ch,$str);}
				  else{print_tree_xml($ch,$str);};
				 };
		     };
}
read_httpsdescriptionprevnextTop
sub read_https {
init();
 my $params_string;
 my $cgi_metod=$ENV{'REQUEST_METHOD'};
 my $content_length=$ENV{'CONTENT_LENGTH'};
 my $content_type=$ENV{'CONTENT_TYPE'};
if(defined($cgi_metod))
{
if ($cgi_metod eq 'POST')
    { if($content_type eq 'application/x-www-form-urlencoded')
		{if(read(STDIN, $params_string, $content_length)!=$content_length)
		 {exiting_code("Cannot read parameters passed\n");};
		}
	 else
		{eval{require CGI;
	     $cgi_object=new CGI();
		 %XS_PARAMS=$cgi_object->Vars();};
		 if($@){error_log("CGI error $@\n");exiting_code("CGI error: cannot read parameters\n");};
		 goto start_prog;
	    };
    }
elsif ($cgi_metod eq 'GET' || $cgi_metod eq 'HEAD')
    {
      $params_string=$ENV{'QUERY_STRING'};
    }
else{exiting_code("Unknown method $cgi_metod\n");};
 my @params_array=split(/[&;]/,$params_string);
 for my $param (@params_array)
	{my ($key,$value)=split(/=/,$param,2);
     $value=~tr/+/ /;
$value=~s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg;
$key=~tr/+/ /;
$key=~s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg;
if(!defined($XS_PARAMS{$key})) {$XS_PARAMS{$key}=$value;}else{$XS_PARAMS{$key}=join("\0",$XS_PARAMS{$key},$value)}; }; }; start_prog: my $cookie_string=''; if($ENV{'HTTP_COOKIE'}) {$cookie_string=$ENV{'HTTP_COOKIE'};} elsif($ENV{'COOKIE'}) {$cookie_string=$ENV{'COOKIE'};}; if($cookie_string) {my @params_cookie=split(/;/,$cookie_string); for my $kv (@params_cookie) {$kv=~s/^\s+//sg;
$kv=~s/\s+$//sg;
if($kv) {my ($key,$value)=split(/=/,$kv,2); if($key){ if(!defined($XS_PARAMS{$key})){$XS_PARAMS{$key}=$value;};}; }; }; }; return\% XS_PARAMS; } 1; __END__
}
read_xml_filedescriptionprevnextTop
sub read_xml_file {
	my $file=shift;
	my $root=createtree($file,'xml');
	strip_all_spaces($root);
	return $root;
}
read_xsl_filedescriptionprevnextTop
sub read_xsl_file {
	my $file=shift;
	my $root=createtree($file,'xsl');
	my $chs=$root->{children};
	for my $st (@{$chs})
	{if(($st->{nodename} eq 'xsl:stylesheet')||($st->{nodename} eq 'xsl:transform'))
	  {return $st;};};
	my $t=newnode('xsl:template','');
	$t->{attsnumb}=1;
	$t->{attslist}={};
	$t->{attslist}->{'match'}='/';
	push @{$t->{children}}, newnode('@match','/');
#	push @{$t->{children}},@{$chs};
my $newst=newnode('xsl:stylesheet',''); $newst->{attsnumb}=0; $newst->{attslist}={}; push @{$newst->{children}},$t; return $newst;
}
save_to_filedescriptionprevnextTop
sub save_to_file {
my $doc=shift;
 my $chs=$doc->{children};
 my %docatts;
 my $i=0;
 my $ch=$chs->[0];
 my $size=$#{$chs};
 while($ch->{nodename}=~/^@/)
	 {my $aname=substr($ch->{nodename},1);$docatts{$aname}=$ch->{nodedata};
      $i++;$ch=$chs->[$i];};
my $file=$docatts{'system'};
my $str='';
if($file)
	{$file=file_name($XML_BASE,$file);
     my $metod=$docatts{'method'};
	 if(!$metod){$metod=$output_method;};
	 my $encod=$docatts{'encoding'};
	 if(!$encod){$encod=$output_encoding;};
	 my $omit_decl=$docatts{'omit-xml-declaration'};
	 if(!$omit_decl){$omit_decl=$omit_xmldecl;};
	 if(($metod eq 'xml') and ($omit_decl eq 'no')){$str.='<?xml version="1.0"';
	  if($encod){$str.=' encoding=';$str.="\"$encod\"";};
	  $str.='?>';if($output_indent){$str.="\n";};};

	  while($i<=$size)
		{$ch=$chs->[$i];
          print_with_method($metod,$ch,\$str);  
	      $i++;
		};
open(FILE,"> $file") or exiting_code("cannot open ($file) for writing\n");
if($CHARS_MODEL eq 'bytes'){binmode(FILE);}
else{
     if($] > 5.007){binmode(FILE,":utf8");};
    };
print FILE $str;
close(FILE);
	}
else{exiting_code("xml\-document has no system attribute\n");};
}
save_upload_filedescriptionprevnextTop
sub save_upload_file {
my ($expr,$stpath)=@_;
 my $hfile=$expr->{left};
 my $newfile=eval_expr($expr->{right},$stpath,1);
 if((!ref($hfile)) or ($hfile->{opname} ne '$')){exiting_code("save\-file function has invalid first arg\n");};
 $newfile=~s/\s+//sg;
if($newfile) {if(is_file_name_notsafe($newfile)){exiting_code("File name ($newfile) contains Perl IO chars\n");}; if(defined($cgi_object)){ my $fname=$hfile->{left}; my $fh=undef; eval{$fh=$cgi_object->upload($fname);}; if($@){exiting_code("Error in CGI $@\n");}; if($fh){ my $com='> '.$newfile; open(FILEUPLOAD,$com) or exiting_code("Cannot open file ($newfile) for uploading\n"); binmode(FILEUPLOAD); my $buff=''; while(read($fh,$buff,4096)){print FILEUPLOAD $buff;}; close(FILEUPLOAD); }else{$newfile='';}; }else{$newfile='';}; } else{exiting_code("save\-file function has invalid second arg\n");}; return $newfile;
}
scanelemetsdescriptionprevnextTop
sub scanelemets {
my ($newselect,$path,$seq)=@_;
my $chen=$path->[0]->{children};
my $i=$path->[0]->{attsnumb};
my $ch=$chen->[$i];
  while($ch)
	{ if(defined($ch->{attsnumb}))
		{my $newpath=[$ch,@{$path}];
	     node_seq($newselect,$newpath,$seq);
		 if($ch->{children}->[0]){
		 scanelemets($newselect,$newpath,$seq);};
		};
      $i++;
	  $ch=$chen->[$i];
	};
}
scannamesdescriptionprevnextTop
sub scannames {
my ($name,$newselect,$path,$seq)=@_;
my $chen=$path->[0]->{children};
FOR:for my $ch (@{$chen})
	{ if($ch->{nodename} eq $name)
		{my $newpath=[$ch,@{$path}];
	     node_seq($newselect,$newpath,$seq);
	     if($ch->{children}->[0]){scannames($name,$newselect,$newpath,$seq);};
		 next FOR;
		};
      if($ch->{children}->[0])
		{my $newpath=[$ch,@{$path}];
	     scannames($name,$newselect,$newpath,$seq);
		};
	};
}
scannodesdescriptionprevnextTop
sub scannodes {
my ($newselect,$path,$seq)=@_;
my $chen=$path->[0]->{children};
  for my $ch (@{$chen})
	{ if($ch->{nodename}!~/^@/){
	     my $newpath=[$ch,@{$path}];
	     node_seq($newselect,$newpath,$seq);
		 if($ch->{children}->[0]){
		 scannodes($newselect,$newpath,$seq);};
		};
	};
}
select_conditiondescriptionprevnextTop
sub select_condition {
my $ha=shift;
my $ts=shift;
my $conds=$ts->{condition};
my $tms=$ts->{template};
my $size=$#{$conds};
	for (my $i=0;$i<=$size;$i++) {
		my $cond=$conds->[$i];
		if($cond==0){return $tms->[$i];}
		elsif($cond>0){if($_position_==$cond){return $tms->[$i];};}
		else
		{my $expr=$compiled_expresions[-$cond];
		 if(eval_expr($expr,$ha,0)){return $tms->[$i];};};
	}
return undef;
}
select_templatedescriptionprevnextTop
sub select_template {
my ($ha,$templates_keys)=@_;
 my $str=$ha->[0]->{nodename};

 my @stack=();
 my @idx=();
 my @depths=();

 my $i=1;
 my $depth=1;
	 
 my $hstep=$templates_keys->{$str};
 if($hstep)
	 {
	 if(defined($ha->[0]->{attsnumb}))
		 {
	     if($templates_keys->{'*'})
	       {unshift @stack, $templates_keys->{'*'};
	        unshift @idx,1;
	        unshift @depths,1;};
		 }
     else
		 {if($str=~/^@/){
	       if($templates_keys->{'@*'})
	       {unshift @stack, $templates_keys->{'@*'};
	        unshift @idx,1;
	        unshift @depths,1;};};
		 };
     }
 else{if(defined($ha->[0]->{attsnumb})){$hstep=$templates_keys->{'*'};}
      else{if($str=~/^@/){$hstep=$templates_keys->{'@*'};};};
     };

 my $ret=undef;
 my $order=0;
    while($hstep)
	{   my $bool=0;
		if($hstep->{template}){if($order<$depth){
			                    if($hstep->{condition}->[0]==0)
			                       {$order=$depth;
		                            $ret=$hstep->{template}->[0];
									}
                                else{my $t=select_condition($ha,$hstep);
								     if($t){$order=$depth;$ret=$t;};  
									};
							   };};
		
		if($ha->[$i])
		{  $str=$ha->[$i]->{nodename};  
		   my $hn=$hstep->{ancestor};
           my $hnp=$hstep->{parent};
		   my $i0=$i;
		   if($hn){if($hn->{'*'}){$bool=1;$i++;$depth++;$hstep=$hn->{'*'};
		                          };};
		   if($hnp){if($hnp->{'*'}){
			                      if($bool){
			                      unshift @stack,$hstep;
								  unshift @idx,$i;
								  unshift @depths, $depth;
								  }else{$i++;$depth++;};
								  $bool=1;
								  $hstep=$hnp->{'*'};
		                          };};
		   if($hn)
				{
		         my $str0=$str;
			     loop: while($str0)
					{
					 if($hn->{$str0}){
						          if($bool){
                                  unshift @stack,$hstep;
								  unshift @idx,$i;
								  unshift @depths, $depth;
					              }else{$depth++;$i++;};
								  $bool=$i;$i0++;
								  $i=$i0;
								  $hstep=$hn->{$str0};
								  last loop;
								  };
					   $i0++;
					   if($ha->[$i0]){$str0=$ha->[$i0]->{nodename};}else{$str0='';};
					};
                };
		   if($hnp){if($hnp->{$str}){
			                      if($bool){
			                      unshift @stack,$hstep;
								  unshift @depths, $depth;
								  unshift @idx,$i;
								    if($bool>1){$i=$bool;};
								  }else{$depth++;$i++;};
								  $bool=1;
                                  $hstep=$hnp->{$str}; 
		                          };};
		};
		if(!$bool){
	   $hstep=shift @stack;
	   $i=shift @idx;
	   $depth=shift @depths;
		};
	};
 return $ret;
}
set_atts_flagdescriptionprevnextTop
sub set_atts_flag {
my $rtf=shift;
 my $inum=0;
 for my $ch (@{$rtf->{children}})
	{if($ch->{nodename}=~/^@/){$inum+=1;}
     else{my $nname=$ch->{nodename};
	 if(($nname ne 'text()')and($nname ne 'comment()')){set_atts_flag($ch);};
	     };
	};
$rtf->{attsnumb}=$inum;
}
set_glob_paramsdescriptionprevnextTop
sub set_glob_params {
			my $parame=shift;
			my $pname=$parame->{attslist}->{name};
			if($pname)
			{if((!defined($glob_strings{$pname}))&&(!defined($glob_objects{$pname}))&&(!defined($glob_vars{$pname})))
				{my $type=$parame->{attslist}->{as};
			        if(defined($type))
					{my $passval=$XS_PARAMS{$pname};
						if(defined($passval))
						{if($CHARS_MODEL ne 'bytes'){
							if($] > 5.007){require Encode; Encode::_utf8_on($passval);}
							else{$passval=pack('U0C*', unpack ('C*', $passval));};};
					     my $dsize=$parame->{attslist}->{'max-size'};
					     if(defined($dsize))
						 {if($dsize=~/^\d+$/)
							 {if(length($passval)>$dsize){exiting_code("exceed length limitation for value of param\" $pname\"\n");};}
						  else
							 {exiting_code("invalid value of max\-size attribute\n");};};

						 if($type eq 'expression')
						 {if(($passval!~/\$/s)and($passval!~/document\s*\(/s)){$glob_objects{$pname}=$passval;}
						  else{exiting_code("illegal value of expression\" $pname\" of expression type\n");};
						 }
						 elsif($type eq 'number')
						 {if($passval=~/$_is_number/){$glob_objects{$pname}=$passval;}
						      else{exiting_code("illegal value of number\" $pname\"\n");};
						 }
                         elsif($type eq 'int')
						 {if($passval=~/^-?[0-9]+/){$glob_objects{$pname}=$passval;}
						      else{exiting_code("illegal value of int\" $pname\"\n");};
						 }
                         elsif($type eq 'unsigned-int')
						 {if($passval=~/^[0-9]+/){$glob_objects{$pname}=$passval;}
						      else{exiting_code("illegal value of unsigned-int\" $pname\"\n");};
						 }
                         elsif($type eq 'string'){$glob_strings{$pname}=$passval;}
						 elsif($type eq 'set'){
							 my $pset=newnode('/','');$pset->{attsnumb}=0;
							 my @values=split("\0",$passval);
							 for my $value (@values) {
                             my $vnode=newnode('value','');$vnode->{attsnumb}=0;
							 if($value ne ''){
							 push @{$vnode->{children}},newnode('text()',$value);};
							 push @{$pset->{children}},$vnode;
							 };
							 my $ppset=[$pset];
							 $glob_vars{$pname}=[$ppset];
						 }
						 elsif($type eq 'file'){$glob_vars{$pname}=$passval;}
						 else{exiting_code("unknown type\" $type\" of param\" $pname\"\n");};
						}
						else
						{my $default=$parame->{attslist}->{'select'};
						 if(($type ne 'file') and ($type ne 'set')){
						 if(defined($default))
							 {if($default=~/^(\'|\")(.*)(\'|\")$/s){$glob_strings{$pname}=$2;}
						      else{$glob_objects{$pname}=$default;};
							 }
                         else{$default=node_text($parame);
						      if($default){$glob_strings{$pname}=$default;}
							  else{exiting_code("param\" $pname\" is not passed\n");};
							 };
						 }else{if($type eq 'file'){$glob_vars{$pname}='';}
						       else{my $sp=[newnode('/','')];$sp->[0]->{attsnumb}=0;
							        my $set=tree_fragment($parame,$sp);
									if($set->[0]){$glob_vars{$pname}=$set;}
									else{exiting_code("param\" $pname\" is not passed\n");};
							   };
						      };
						};
					}
					else
					{my $pval=$parame->{attslist}->{'select'};
					 if(defined($pval))
					 {if($pval=~/^(\'|\")(.*)(\'|\")$/s)
						  {$glob_strings{$pname}=$2;}
					  else{$glob_objects{$pname}=$pval;};
					 }
					 else{$pval=node_text($parame);$glob_strings{$pname}=$pval;};		   
					};
				}
				else{exiting_code("redefined param or variable name\" $pname\"\n");};
			};
}
set_loc_paramsdescriptionprevnextTop
sub set_loc_params {
my $instr=shift;
my $npar=0;
for my $ch (@{$instr->{children}})
	{if($ch->{nodename} eq 'xsl:with-param')
		{
         my $name=$ch->{attslist}->{name};
		 my $sel=$ch->{attslist}->{'select'};
	    if($name)
			{$npar++;
		     if(!defined($instr->{params})){$instr->{params}=[];};
			 if($sel){compile_instr_attr_f($ch,'select');};
			 push @{$instr->{params}},$ch;
			}
		else{exiting_code("xsl:with\-param has no name attribute\n");};
		}
     elsif($ch->{nodename} eq 'xsl:sort')
		{if(!defined($instr->{'sort'})){$instr->{'sort'}=[];};
	     push @{$instr->{'sort'}}, init_sort($ch);
		};
	};
$instr->{nparams}=$npar;
}
set_template_keydescriptionprevnextTop
sub set_template_key {
my ($str, $htempl,$templates_keys,$cond)=@_;
my @a=split('/',$str);
if($str eq '/'){push @a,'/';};
if($a[0] eq ''){$a[0]='/';};
my $next='';
my $hname=$templates_keys;
my $hstate={};
my $last=pop @a;
loop: while(1)
{   $next=pop @a;
	if(!defined($hname->{$last})){$hname->{$last}={};};
    $hstate=$hname->{$last};
if(defined($next))
  {
	if($next ne '')
	{
		if(!defined($hstate->{parent})){$hstate->{parent}={};};
		$hname=$hstate->{parent};
		$last=$next;
	}else
	{
		if(!defined($hstate->{ancestor})){$hstate->{ancestor}={};};
		$hname=$hstate->{ancestor};
		$last=pop @a;
	};
  }
  else {last loop;};
};
  if(!defined($hstate->{template}))
	 {$hstate->{template}=[$htempl];
      $hstate->{condition}=[$cond];}
  else
	 {my $conds=$hstate->{condition};
      my $bool=1;
locfor:for(my $i=0;$i<=$#{$conds};$i++){my $ocond=$conds->[$i];
		                               if($ocond==$cond){$bool=0;last locfor;};};
	  if($bool)
		 {if($cond!=0){
		   unshift @{$hstate->{template}}, $htempl;
	       unshift @{$hstate->{condition}}, $cond;}
		   else{
		   push @{$hstate->{template}}, $htempl;
	       push @{$hstate->{condition}}, $cond;};
		 };
	  };
};

my @_focus_stack_=();
my @_count_stack_=();
my $_focus_=[];
my $_position_=0;
my $_last_=0;
my $_index_=0;
my $_last_node_=0;
########################### xpath #################################
my $_xpath_expr_error_=undef; my $_fotal_error_=undef; my @_expr_errors_code_=("1 missing\) or extra\( in xpath expression\n", "2 missing\( or extra\) in xpath expression\n", "3 invalid number of square brackets\n", "4 missing right or left arg of binary operation\n", "5 invalid expression, may be forgotten space before and after minus\n or invalid params of function or missing operation\n", "6 wrong use of current, local-time or key function\n", "7 invalid number of function arguments or not suppored function\n", "8 id function is not supported, use key function instead\n", "9 invalid step pattern in expression\n"); my $_default_path_expr={'opname'=>'#','right'=>{'axis'=>0,'name'=>'node()'}}; my @compiled_expresions=(undef,$_default_path_expr); my $namber_of_exprs=2; #my $_is_number='^-?(?:\d+(?:\.\d*)?|\.\d+)$';
my $_is_number='^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$'; my %_xpath_boolean=('false'=>1,'true'=>1,'boolean'=>1,'not'=>1, '='=>1,'!='=>1,'and'=>1,'or'=>1,'>'=>1,'<'=>1,'>='=>1,'<='=>1, 'contains'=>1,'starts-with'=>1,'save-file'=>1); my @literal_replace=undef;
}
st_pidescriptionprevnextTop
sub st_pi {
my ($p,$target,$data)=@_;
     if($target eq 'xml-stylesheet')
		{if($data=~/href\s*=\s*(\"|\')(.+?)(\"|\')/s){$_source_style=$2;};
		 $p->setHandlers('Proc'=>undef);};
}
strip_all_spacesdescriptionprevnextTop
sub strip_all_spaces {
my $el=shift;
 my $bi=$el->{attsnumb};
 if(defined($bi))
	{my $chs=$el->{children};
	 my $size=$#{$chs};
	 my $rm=0;
loop: while($bi<=$size)
		{my $ch=$chs->[$bi];
	     if($ch->{nodename} eq 'text()')
		 {if($ch->{nodedata}=~/^\s*$/s){
			 if($bi<$size){$rm++;$bi++;}
			 else{if($size!=0){my $pnode=$chs->[$bi-1];
			     if(defined($pnode->{attsnumb})){$rm++;last loop;};};};
			 };
		 };
         if($rm){$chs->[$bi-$rm]=$chs->[$bi];};
         $bi++;
		};
    while($rm>0){pop @{$chs};$rm--;};
	for my $ch0 (@{$chs}) {
    if(defined($ch0->{attsnumb})){strip_all_spaces($ch0);};
	};
	};
}
strip_st_spacesdescriptionprevnextTop
sub strip_st_spaces {
my $el=shift;
 my $bi=$el->{attsnumb};
 if(defined($bi))
	{my $chs=$el->{children};
	 my $size=$#{$chs};
	 my $rm=0;
loop: while($bi<=$size)
		{my $ch=$chs->[$bi];
	      if($ch->{nodename} eq 'text()')
			{if($ch->{nodedata}=~/^\s*$/s)
				{my $pnode=$chs->[$bi-1];
		         my $fnode=$chs->[$bi+1];
				 if($pnode && $fnode)
				 {if(($pnode->{nodename}=~/^xsl\:/)&&($fnode->{nodename}=~/^xsl\:/))
					{$rm++;$bi++;}
				  else{
                  if(($pnode->{nodename}=~/^@/)&&($fnode->{nodename}=~/^xsl\:/)&&($el->{nodename}=~/^xsl\:/))
					  {$rm++;$bi++};
				      };
                 }
				 elsif($pnode)
				 {if(($el->{nodename}=~/^xsl\:/)&&($pnode->{nodename}=~/^xsl\:/))
					{$rm++;last loop;};
				 }
				 elsif($fnode)
				 {if(($el->{nodename}=~/^xsl\:/)&&($fnode->{nodename}=~/^xsl\:/))
					 {$rm++;$bi++;};
				 };
				};
			};
         if($rm){$chs->[$bi-$rm]=$chs->[$bi];};
         $bi++;
		};
    while($rm>0){pop @{$chs};$rm--;};
	for my $ch (@{$chs}) {
    if(defined($ch->{attsnumb})){strip_st_spaces($ch);};
	};
	};
}
transformdescriptionprevnextTop
sub transform {

my $xml=undef;
my $xml_file=$XS_PARAMS{'source'};
if($xml_file){
	if($xml_file=~/\0/sg){error_log("File ($xml_file) contains string end (0) character\n");
    exiting_code("Illigal name of file\n");};
	if($xml_file!~/\.xml$/){$xml_file=join('',$xml_file,'.xml');};$xml=read_xml_file($xml_file);}
else{$xml=newnode('/','');$xml->{attsnumb}=0;};
my $st_file='';
if($XS_PARAMS{'style'}){$st_file=$XS_PARAMS{'style'};
	if($st_file=~/\0/sg){error_log("File ($st_file) contains string end (0) character\n");
    exiting_code("Illigal name of file\n");};
if($st_file!~/\.xsl$/){$st_file=join('',$st_file,'.xsl');};}
else{if($_source_style){$st_file=$_source_style;$XSLT_BASE=$XML_BASE;}
     else{if($xml_file=~/\.xml$/){$st_file=$xml_file;$st_file=~s/\.xml$/\.xsl/;};};};
if($st_file) { my $xsl_stylesheet=read_xsl_file($st_file); compile_stylesheet($xsl_stylesheet,$xml); if(defined($ENV{'CONTENT_LENGTH'}) && ($ENV{'CONTENT_LENGTH'}>$MAX_CONTENT_SIZE)){exiting_code("exceed data length ($MAX_CONTENT_SIZE) limitation\n");}; my $new_xml=newnode('/',''); $new_xml->{attsnumb}=0; my $start_source_path=[$xml]; my $start_result_path=[$new_xml]; my $t_mode=$template_modes{'no'}; my $t=select_template($start_source_path,$t_mode); if($t){eval_template($t,$start_source_path,$start_result_path);} else{apply_templates($_default_template,$start_source_path,$start_result_path);}; return $new_xml; }else{print_error("Stylesheet is not passed");};
}
tree_fragmentdescriptionprevnextTop
sub tree_fragment {
my ($varel,$stpath)=@_;
 my $rtf=newnode('/','');
 my $rtfpath=[$rtf];
 eval_template($varel,$stpath,$rtfpath);
 set_atts_flag($rtf);
 my $nset=[$rtfpath];
 if($rtf->{attsnumb}){exiting_code("result tree fragment cannot have attribute nodes");};
 if($rtf->{children}->[0]){return $nset;}
 else{return [];};
}
try_correct_argdescriptionprevnextTop
sub try_correct_arg {
	my $c_op=shift;
	my $ngrs=shift;
		  if(($c_op eq '*')||($c_op eq 'mod')||($c_op eq 'div')||($c_op eq 'and')||($c_op eq 'or'))
		  {$c_op.=' ';$c_op=' '.$c_op;push @{$ngrs},$c_op;}
	      else{$_fotal_error_="FOTAL ERROR";xpath_errors(3);};
}
value_ofdescriptionprevnextTop
sub value_of {
	my ($instr,$stpath,$rtpath)=@_;
	my $code=$instr->{cselect};
	if(defined($code))
	{   my $text=eval_expr($code,$stpath,1);
        if($text ne ''){my $rnode=$rtpath->[0];
		    my $n={};
			$n->{nodename}='text()';
	        $n->{children}=[];
	        $n->{nodedata}=$text;
			if($instr->{noe}){$n->{noe}=1;};
		    push @{$rnode->{children}},$n;};			 
	}
    else
	{   compile_instr_attr_f($instr,'select');
	    if(defined($instr->{attslist}->{'disable-output-escaping'}) &&($instr->{attslist}->{'disable-output-escaping'} eq 'yes')){$instr->{noe}=1;};
		value_of($instr,$stpath,$rtpath);
	};
}
var_valuedescriptionprevnextTop
sub var_value {
my ($expr,$stpath,$type)=@_;
 my $value=get_var_val($expr);
if(ref($value))
	{my $cond=$expr->{conds};
     my $ret=$value;
	 if($cond){$ret=filter_node_seq($value,$cond);};
	 my $pexpr=$expr->{right};
     if($pexpr)
		{my $newns=[];
	     for my $path (@{$ret})
		 {node_seq($pexpr->{right},$path,$newns);};
	     $ret=$newns;
		};
     return convert_nodeset($type,$ret);
	}
else
	{return $value;};
}
xml_filedescriptionprevnextTop
sub xml_file {
my ($files,$ns)=@_;
 my $old_base=$XML_BASE; 
 if(ref($files))
	{for my $path (@{$files})
		{my $spath=node_text($path->[0]);
         my $ds=read_xml_file($spath,'xml');
		 $XML_BASE=$old_base;
		 my $rp=[$ds];push @{$ns},$rp;};
	}
 else
	{my $ds=read_xml_file($files,'xml');
	 $XML_BASE=$old_base;
     my $rp=[$ds];push @{$ns},$rp;
	};
}
xpath_errorsdescriptionprevnextTop
sub xpath_errors {
   my $ecode=shift;
   if($_xpath_expr_error_)
	   {$_xpath_expr_error_.=$_expr_errors_code_[$ecode];}
   else
	   {$_xpath_expr_error_=$_expr_errors_code_[$ecode];};
}
xsl_attributedescriptionprevnextTop
sub xsl_attribute {
my ($instr,$stpath,$rtpath)=@_;
      my $aname=get_attr_value('name',$instr,$stpath,$rtpath);
	  if($aname=~/^[\w\-\:\.]+$/){$aname='@'.$aname;my $anode=newnode($aname,'');
	                              my $newrtpath=[$anode];eval_template($instr,$stpath,$newrtpath);
	                              my $avalue=node_text($anode);
								  $anode->{children}=[];
								  #if($avalue ne '')
{$anode->{nodedata}=$avalue; my $ce=$rtpath->[0]; my $size=$#{$ce->{children}}; if($size>=0){ for (my $i=0;$i<=$size;$i++) { my $n=$ce->{children}->[$i]; if($n->{nodename} eq $aname){$n->{nodedata}=$avalue;goto end;}; }; my $lastn=$ce->{children}->[$size]; if($lastn->{nodename}=~/^@/){push @{$ce->{children}}, $anode;}; end: }else{push @{$ce->{children}}, $anode;}; }; } else{exiting_code("invalid name of new attribute:\" $aname\"\n");};
}
xsl_call_templatedescriptionprevnextTop
sub xsl_call_template {
my ($instr,$stpath,$rtpath)=@_;
 my $name=$instr->{attslist}->{name};
 my $t=$template_names{$name};
 my $nump=$instr->{nparams};
 if(!defined($nump)){set_loc_params($instr);$nump=$instr->{nparams};};
 $param_nums=$nump;
 if($nump){init_loc_params($instr,$stpath);};
 if($t){eval_template($t,$stpath,$rtpath);}
 else{exiting_code("no template with name\"$name\"\n")};
 while($nump>0){shift @local_vars_names;shift @local_vars_values;$nump--;};
 return 0;
}
xsl_commentdescriptionprevnextTop
sub xsl_comment {
my ($instr,$stpath,$rtpath)=@_;
 my $rnode=$rtpath->[0];
 my $comnode=newnode('/','');$comnode->{attsnumb}=0;
 my $cpath=[$comnode];
 eval_template($instr,$stpath,$cpath);
 my $str=node_text($comnode);
 if($str ne '')
	{push @{$rnode->{children}},newnode('comment()',$str);};
}
xsl_copydescriptionprevnextTop
sub xsl_copy {
	my ($instr,$stpath,$rtpath)=@_;
	my $cnode=$stpath->[0];
	my $snode=$rtpath->[0];
 if($cnode->{nodename} ne '/')
  {   
	if($cnode->{nodename}=~/^@/)
	{unshift @{$snode->{children}},newnode($cnode->{nodename},$cnode->{nodedata});}
	elsif($cnode->{nodename} eq 'text()')
	{push @{$snode->{children}},newnode('text()',$cnode->{nodedata});}
	else
	{my $n=newnode($cnode->{nodename},'');
	 push @{$snode->{children}},$n;
	 unshift @{$rtpath},$n;
	 eval_template($instr,$stpath,$rtpath);
	 shift @{$rtpath};
	};
  }else{eval_template($instr,$stpath,$rtpath);};
}
xsl_copy_ofdescriptionprevnextTop
sub xsl_copy_of {
my ($instr,$stpath,$rtpath)=@_;
	my $code=$instr->{cselect};
	if(defined($code))
	{	my $res=eval_expr($code,$stpath,2);
		if(ref($res))
		{my $rnode=$rtpath->[0];
		 for my $ns (@{$res}){my $n=$ns->[0];
		 if($n->{nodename} eq '/'){push @{$rnode->{children}},@{$n->{children}};}
		 else{if($n->{nodename}!~/^@/){push @{$rnode->{children}},$n};};
		 };
		}
		else
		{if($res ne ''){my $rnode=$rtpath->[0];
		 push @{$rnode->{children}},newnode('text()',$res);};
		};
	}
    else
	{ compile_instr_attr_f($instr,'select');
	  xsl_copy_of($instr,$stpath,$rtpath);
	};
}
xsl_documentdescriptionprevnextTop
sub xsl_document {
my ($expr,$stpath,$type)=@_;
 my $left=eval_expr($expr->{left},$stpath,2);
 my $right=undef;
 if($expr->{right}){$right=eval_expr($expr->{right},$stpath,2);};
 my $ns=[];
 my $old_base=$XML_BASE; 
if(!$right)
{xml_file($left,$ns);}
else
{if(ref($right))
	{for my $path (@{$right})
	 {my $n_base=node_text($path->[0]);
      $XML_BASE=$n_base;
	  xml_file($left,$ns);};
	}
 else
	{$XML_BASE=$right;
     xml_file($left,$ns);};
};
$XML_BASE=$old_base;

if($expr->{param})
{my $nns=[];
 my $pexpr=$expr->{param};
 for my $path (@{$ns})
 {node_seq($pexpr->{right},$path,$nns);};
  $ns=$nns;
};
return convert_nodeset($type,$ns);
}
xsl_elementdescriptionprevnextTop
sub xsl_element {
  my ($instr,$stpath,$rtpath)=@_;
	my $ename=get_attr_value('name',$instr,$stpath,$rtpath);
	  if($ename=~/^[\w\-\:\.]+$/){my $ne=newnode($ename,'');my $ce=$rtpath->[0];
	                              push @{$ce->{children}}, $ne;
	                              unshift @{$rtpath},$ne;
								  eval_template($instr,$stpath,$rtpath);shift @{$rtpath};
								 }
      else{exiting_code("invalid name of new element:\" $ename\"\n");};
}
xsl_ifdescriptionprevnextTop
sub xsl_if {
	my ($instr,$stpath,$rtpath)=@_;
	my $code=$instr->{ctest};
	if(defined($code))
	 {if(eval_expr($code,$stpath,0)){eval_template($instr,$stpath,$rtpath);};}
	else
	 {my $testexpr=compile_instr_attr_f($instr,'test');
	  if(eval_expr($testexpr,$stpath,0)){eval_template($instr,$stpath,$rtpath);};
	 };
}
xsl_messagedescriptionprevnextTop
sub xsl_message {
my ($instr,$stpath,$rtpath)=@_;
 my $message=newnode('/','');$message->{attsnumb}=0;
 my $mpath=[$message];
 eval_template($instr,$stpath,$mpath);
 print_output($message);
 if($instr->{attslist}->{terminate} eq 'yes'){exit;};
}
xsl_numberdescriptionprevnextTop
sub xsl_number {
my ($instr,$stpath,$rtpath)=@_;
 my $val=$instr->{attslist}->{value};
 my $level=$instr->{attslist}->{level};
 my $format=$instr->{attslist}->{'format'};
 if(!$format){$format='1';};
 my $rt=$rtpath->[0];
 if(!$val)
	{
     if($level)
		{my $nances=$#{$stpath};
	     my $from=$instr->{attslist}->{from};
		 if($from){for (my $k=0;$k<=$nances;$k++){if($stpath->[$k]->{nodename} eq $from){$nances=$k-1;};};};
		 my $count=$instr->{attslist}->{count};
		 my @els=split('\|',$count);
		 if($level eq 'multiple')
			{
			 if(!defined($instr->{attslist}->{numbers})){$instr->{attslist}->{numbers}=[];
			 $instr->{attslist}->{cash}={};};
			 my $ns=$instr->{attslist}->{numbers};
			 my $cash=$instr->{attslist}->{cash};
			 my $snode=$stpath->[0];
			 if($cash->{$snode}){$ns=$cash->{$snode};}
			 else
				{my $i=-1;
				 my $startbit=0;
			     if($count)
				 {
			     for my $el (@els){for (my $k=0;$k<=$nances;$k++)
				 {my $stn=$stpath->[$k];if($stn->{nodename} eq $el){$i++;if($startbit==0){if(has_preceding_node($stpath,$k,\@els)){$startbit=1;};};};};};
				 }else{$i=$nances;$startbit=1;};
			     if($startbit==0){$instr->{attslist}->{numbers}=[];$ns=$instr->{attslist}->{numbers};};
			     if($i>=0)
				  {my $size=$#{$ns};
			       if($size==$i){$ns->[$i]=$ns->[$i]+1;}
				   elsif($size>$i){$ns->[$i]=$ns->[$i]+1;while($size>$i){pop @{$ns};$size--;};}
				   else{while($size<$i){push @{$ns},1;$size++;};};
				   $cash->{$snode}=[@{$ns}];
				  }else{$instr->{attslist}->{numbers}=[];goto blockend;};
				};
				 my $str='';
				    if($format=~/^(\W+)(.*)/){$str.=$1;$format=$2;};
					my $lastsep='';
					my $strend='';
					if($format=~/(.*)(\W+)$/){$format=$1;$strend=$2;};
					for my $n (@{$ns})
						{$str.=$lastsep;
					     if($format=~/^(\w+)(\W+)(\w.*)/){$format=$3;$lastsep=$2;}
						 else{if($lastsep eq ''){$lastsep='.';};};
						 $str.=$n;
					    };
                 $str.=$strend;
				 push @{$rt->{children}},newnode('text()',$str);
				 blockend:
			}
        elsif($level eq 'any')
			{
			 if(!defined($instr->{attslist}->{numbers})){$instr->{attslist}->{numbers}=[0];};
			 my $ns=$instr->{attslist}->{numbers};
			 if($count)
				{
			 for my $el (@els){for (my $k=0;$k<=$nances;$k++)
				 {my $stn=$stpath->[$k];
			      if($stn->{nodename} eq $el){$ns->[0]=$ns->[0]+1;goto end;};};};
				}else{if($nances>0){$ns->[0]=$ns->[0]+1;goto end;};};
             goto finish;
			 end:
             my $num=$ns->[0];
				 my $str='';
			     if($format=~/^(\W+)(.*)/){$str.=$1;$format=$2;};
				 $str.=$num;
				 if($format=~/^(\w+)(.*)/){$str.=$2;};
				 push @{$rt->{children}},newnode('text()',$str);
             finish:
			}
        elsif($level eq 'single')
			{
			};
		}
	 else
		{    my $n=$_position_;
	         if($format=~/^(\W*)(\w+?)(\W*)/){my $fn=$1;$fn.=$n;$fn.=$3;
			 push @{$rt->{children}},newnode('text()',$fn);}
			 else{push @{$rt->{children}},newnode('text()',$n);}
		};
	}
 else
	{
	};
}
xsl_paramdescriptionprevnextTop
sub xsl_param {
my ($instr,$stpath,$rtpath)=@_;
my $name=$instr->{attslist}->{name};
if($name)
	{for (my $k=0;$k<$param_nums;$k++) {
	 if($name eq $local_vars_names[$k]){return 0;};};
	 xsl_var($instr,$stpath,$rtpath);
	 $param_nums++;
	 return 1;
	}
	else{exiting_code("xsl:param has no name attribute\n");};
}
xsl_textdescriptionprevnextTop
sub xsl_text {
my ($instr,$stpath,$rtpath)=@_;
 my $rnode=$rtpath->[0];
 my $i=$instr->{attsnumb};
 my $n=$instr->{children}->[$i];
 if($n->{nodename} eq 'text()')
	{
 if(!defined($n->{noe}))
	{if($instr->{attslist}->{'disable-output-escaping'} eq 'yes')
	 {$n->{noe}=1;}else{$n->{noe}=0;};
	};
 push @{$rnode->{children}},$n;
	};
}
xsl_uniondescriptionprevnextTop
sub xsl_union {
my ($expr,$stpath,$type)=@_;
 my $bool=0;
 my $ns=[];my $es=$expr->{param};
 for my $e (@{$es})
 {if($e->{opname} eq '#'){node_seq($e->{right},$stpath,$ns);}
  elsif($e->{opname} eq '/'){node_seq_from_root($e->{right},$stpath,$ns);}
  else{my $tns=eval_expr($e,$stpath,2);if(ref($tns)){$bool=1;push @{$ns},@{$tns};};};
 };
if($bool)
	{my $fns=[];
	 my %tmp=();
	 for my $n (@{$ns}){my $n0=$n->[0];if(!defined($tmp{$n0})){push @{$fns},$n;$tmp{$n0}=1;};};
	 $ns=$fns;
	};
return convert_nodeset($type,$ns);
}
xsl_vardescriptionprevnextTop
sub xsl_var {
my ($instr,$stpath,$rtpath)=@_;
	my $code=$instr->{attslist}->{'select'};
	my $name=$instr->{attslist}->{name};
if($name)
{ if(defined($code))
	{my $select=$instr->{cselect}; 
	 if(defined($select))
	   {   my $value=eval_expr($select,$stpath,2);
		   unshift @local_vars_values,$value;
		   unshift @local_vars_names,$name;
	   }
      else
	   {compile_instr_attr_f($instr,'select');
	    xsl_var($instr,$stpath,$rtpath);};
	}
  else
	{
	 unshift @local_vars_values,tree_fragment($instr,$stpath);
	 unshift @local_vars_names,$name;
	};
}else{exiting_code("xsl:variable has no name attribute\n");};
}
General documentation
No general documentation available.