Menu
▾
▴
[NetScript CVS] CVS: netscript2/src/perl/NetScript/Engine DOMWalker.pm,NONE,1.1 BasicStatement.pm,1.1,1.2 StatementEvaluator.pm,1.1,1.2
|
From: Jan T. <de...@us...> - 2002-04-26 10:49:09
|
Update of /cvsroot/net-script/netscript2/src/perl/NetScript/Engine
In directory usw-pr-cvs1:/tmp/cvs-serv571
Modified Files:
BasicStatement.pm StatementEvaluator.pm
Added Files:
DOMWalker.pm
Log Message:
* added DOMWalker
--- NEW FILE: DOMWalker.pm ---
#--------------------------------------------------------
# $Id: DOMWalker.pm,v 1.1 2002/04/26 10:49:06 derkork Exp $
#
# Class DOMWalker
#
# NetScript and all related materials, such as documentation,
# are protected under the terms and conditions of the Artistic License.
# (C) 2000-2002 by Jan Thomä, insOMnia
# mailto: ko...@in...
#--------------------------------------------------------
use strict;
#/**
# The DOMWalker is the main executing Instance of the Interpreter
# It walks over the incoming DOM, evaluates the Nodes and creates
# the Result-DOM, which is then written out.
# @final
#*/
package NetScript::Engine::DOMWalker;
use vars qw($VERSION);
use NetScript::Engine::BasicStatement;
use XML::DOM2::DOMImplementation;
use XML::DOM2::Document;
use XML::DOM2::Node;
#/**
# Ctor.
# @param an instance of NetScript::Interpreter.
# @public
# @final
#*/
sub new {
my ($proto, $interpreter) = @_;
my $proto = shift; # get Prototype
my $class = ref( $proto ) || $proto;# get the Classname
my $this = {};
$this -> { m_basicStatement } =
NetScript::Engine::BasicStatement -> new();
$this -> { m_interpreter } = $interpreter;
bless( $this, $class ); # create Object
return $this; # return Object
}
#/**
# This sub walks over the given DOM and returns a result
# DOM.The given DOM remains unchanged
# @param an instance of XML::DOM2::Document
# @return an instance of XML::DOM2::Document
# @public
# @final
#*/
sub walkOver {
my ( $this, $document ) = @_;
# Save the document
$this -> { m_document } = $document;
my $di = XML::DOM2::DOMImplementation -> new();
# Create a result document
my $newDocument = $di -> createDocument( {
namespaceURI => "dummy",
qualifiedName => "dummy"
});
$this -> { m_resultDocument } = $newDocument;
# save the reference node
$this -> referenceNode( $newDocument );
$newDocument -> removeChild( {
oldChild => $newDocument -> documentElement()
});
# start processing from up till down, recursively
$this -> startProcess( $document );
$newDocument;
}
#/**
# Processes an level within the tree.
# @private
#*/
sub startProcess {
my ( $this, $node ) = @_;
#we got a node, process it, then process its children...
if ( $node -> nodeType() == XML::DOM2::Node -> ELEMENT_NODE() ||
$node -> nodeType() == XML::DOM2::Node -> DOCUMENT_NODE() ) {
unless( $node -> nodeType == XML::DOM2::Node -> DOCUMENT_NODE() ) {
$this -> processElement( $node );
}
# process the children
my $children = $node -> childNodes();
my $length = $children -> length();
for ( 0..$length-1 ) {
$this -> startProcess( $children -> item ( {
index => $_
} ) );
}
unless( $node -> nodeType == XML::DOM2::Node -> DOCUMENT_NODE() ) {
$this -> elementFinished();
}
}
elsif ( $node -> nodeType() == XML::DOM2::Node ->
PROCESSING_INSTRUCTION_NODE() ) {
$this -> processProcessingInstruction( $node );
}
else {
$this -> processSimpleNode( $node );
}
}
#/**
# Processes a processing instruction. All processing instructions
# which are related to netscript look this way:
# <code><?netscript command [parameter [parameter] ...]?></code>
# These PIs are executed but not copied to the destination tree.
# Parameters are separated by spaces. Non-NetScript-related PIs are
# just copied.
# @private
# @param an instance of XML::DOM2::ProcessingInstruction
#*/
sub processProcessingInstruction {
my ( $this, $pi ) = @_;
my $target = $pi -> target();
if ( $target eq "netscript" ) {
my $data = $pi -> data();
}
else {
# no netscript pi so just copy it.
#import the node to the new document
$this -> processSimpleNode( $pi );
}
}
#/**
# Processes a simple node. Simple nodes have no function.
# They are just copied to the destination document and
# variables within them are replaced.
# @private
# @param an instance of XML::DOM2::Node or its descendants
#*/
sub processSimpleNode {
my ( $this, $node ) = @_;
$this -> basicStatement() -> init(
$this -> interpreter(),
$node,
$this -> result() );
$this -> referenceNode() -> appendChild( {
newChild => $this -> basicStatement() -> evaluate()
});
}
#/**
# Processes an Element node.
# @private
# @param an instance of XML::DOM2::Element
#*/
sub processElement {
my ($this, $element) = @_;
# copy node
$this -> basicStatement() -> init(
$this -> interpreter(),
$element,
$this -> result() );
my $copy = $this -> basicStatement() -> evaluate();
# append to reference node
$this -> referenceNode() -> appendChild({
newChild => $copy
});
#set as new reference node
$this -> referenceNode( $copy ) ;
}
#/**
# Finishes the current reference node.
# @private
#*/
sub elementFinished {
my ($this) = @_;
# set the parent of the current reference node as new reference node
$this -> referenceNode( $this -> referenceNode() -> parentNode() );
}
#/**
# Returns the source document.
# @public
# @return an instance of XML::DOM2::Document
#*/
sub document {
my ( $this ) = @_;
$this -> { m_document };
}
#/**
# Returns the result document.
# @public
# @return an instance of XML::DOM2::Document
#*/
sub result {
my ( $this ) = @_;
$this -> { m_resultDocument };
}
#/**
# Returns or sets the current reference node in the result document.
# @private
# @optional an instance of XML::DOM2::Node
# @return an instance of XML::DOM2::Node
#*/
sub referenceNode {
my ( $this, $node ) = @_;
if ( $node ) {
$this -> { m_referenceNode } = $node;
}
$this -> { m_referenceNode };
}
#/**
# Returns an instance of NetScript::Engine::BasicStatement
# @return an instance of NetScript::Engine::BasicStatement
# @private
#*/
sub basicStatement {
my ( $this ) = @_;
$this -> { m_basicStatement };
}
#/**
# Returns the interpreter.
# @return an instance of NetScript::Interpreter.
# @private
#*/
sub interpreter {
my ( $this ) = @_;
$this -> { m_interpreter };
}
1; # make require happy
Index: BasicStatement.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/BasicStatement.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** BasicStatement.pm 8 Apr 2002 21:30:14 -0000 1.1
--- BasicStatement.pm 26 Apr 2002 10:49:06 -0000 1.2
***************
*** 3,7 ****
#
# Class BasicStatement
! #
# NetScript and all related materials, such as documentation,
# are protected under the terms and conditions of the Artistic License.
--- 3,7 ----
#
# Class BasicStatement
! #
# NetScript and all related materials, such as documentation,
# are protected under the terms and conditions of the Artistic License.
***************
*** 61,66 ****
# Returns a copy of the node. Additionally replaces
# variables in text nodes,
! # @return the value of the statement
! # @abstract
#*/
sub evaluate {
--- 61,66 ----
# Returns a copy of the node. Additionally replaces
# variables in text nodes,
! # @todo Support for ProcessingInstruction
! # @return the value of the statement (XML::DOM2::Node)
#*/
sub evaluate {
***************
*** 74,79 ****
# Check for the Node Type.
! # TODO
!
# return new node...
$this -> setValue( $newNode );
--- 74,97 ----
# Check for the Node Type.
! if ( $newNode -> nodeType() == XML::DOM2::Node -> ELEMENT_NODE() ) {
! # attributes in elements will be checked for variables
! my $attributes = $newNode -> attributes();
! my $length = $attributes -> length();
! for ( 0..$length-1 ) {
! my $attribute = $attributes -> item( { item => $_ } );
! my $value = $attribute -> value();
! $value = $interpreter -> getStatementEvaluator()
! -> evaluateStatement( $value );
! $attribute -> value( { value => $value } );
! }
! }
! elsif ( $newNode -> nodeType() == XML::DOM2::Node -> TEXT_NODE() ) {
! my $text = $newNode -> data();
! $text = $interpreter -> getStatementEvaluator()
! -> evaluateStatement( $text );
! $newNode -> data( { data => $text } );
! }
!
!
# return new node...
$this -> setValue( $newNode );
Index: StatementEvaluator.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/StatementEvaluator.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** StatementEvaluator.pm 8 Apr 2002 21:30:14 -0000 1.1
--- StatementEvaluator.pm 26 Apr 2002 10:49:06 -0000 1.2
***************
*** 11,17 ****
#/**
! # This class represents a Class.
#*/
! package NetScript::Engine::Class;
use vars qw($VERSION);
--- 11,17 ----
#/**
! # The statement Evaluator is capable of evaluating all kinds of statements.
#*/
! package NetScript::Engine::StatementEvaluator;
use vars qw($VERSION);
|
