Menu
▾
▴
[NetScript CVS] CVS: netscript2/src/perl/NetScript/Engine BasicStatement.pm,1.4,1.5 Class.pm,1.3,1.4 DOMWalker.pm,1.3,1.4 Event.pm,1.5,1.6 EventListener.pm,1.2,1.3 EventRelay.pm,1.6,1.7 State.pm,1.3,1.4 Statement.pm,1.4,1.5 StatementEvaluator.pm,1.4,1.5
|
From: Jan T. <de...@us...> - 2002-05-15 18:21:40
|
Update of /cvsroot/net-script/netscript2/src/perl/NetScript/Engine
In directory usw-pr-cvs1:/tmp/cvs-serv17384
Modified Files:
BasicStatement.pm Class.pm DOMWalker.pm Event.pm
EventListener.pm EventRelay.pm State.pm Statement.pm
StatementEvaluator.pm
Log Message:
* complete rewrite of DOMWalker
* added support for WHILE, IF, ELSE and FOR
* bugfixes
Index: BasicStatement.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/BasicStatement.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** BasicStatement.pm 11 May 2002 13:08:20 -0000 1.4
--- BasicStatement.pm 15 May 2002 18:21:37 -0000 1.5
***************
*** 2,6 ****
# $Id$
#
- # Class BasicStatement
#
# NetScript and all related materials, such as documentation,
--- 2,5 ----
***************
*** 29,33 ****
# Globals
#--------------------------------------------------------
! our $VERSION = '1.0';
#/**
--- 28,32 ----
# Globals
#--------------------------------------------------------
!
#/**
Index: Class.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/Class.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Class.pm 11 May 2002 13:08:20 -0000 1.3
--- Class.pm 15 May 2002 18:21:37 -0000 1.4
***************
*** 2,6 ****
# $Id$
#
- # Class Class
# NetScript and all related materials, such as documentation,
# are protected under the terms and conditions of the Artistic License.
--- 2,5 ----
***************
*** 19,23 ****
# Globals
#--------------------------------------------------------
! our $VERSION = '1.0';
#/**
--- 18,22 ----
# Globals
#--------------------------------------------------------
!
#/**
Index: DOMWalker.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/DOMWalker.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** DOMWalker.pm 11 May 2002 13:08:20 -0000 1.3
--- DOMWalker.pm 15 May 2002 18:21:37 -0000 1.4
***************
*** 2,6 ****
# $Id$
#
- # Class DOMWalker
#
# NetScript and all related materials, such as documentation,
--- 2,5 ----
***************
*** 101,106 ****
$this -> { m_basicStatement } =
NetScript::Engine::BasicStatement -> new();
! my %markedNodes = ();
! $this -> { m_markedNodes } = \%markedNodes;
$this -> { m_interpreter } = $interpreter;
--- 100,106 ----
$this -> { m_basicStatement } =
NetScript::Engine::BasicStatement -> new();
! $this -> { m_sourceDocument } = undef;
! $this -> { m_targetDocument } = undef;
! $this -> { m_sourceNodeChanged } = 0;
$this -> { m_interpreter } = $interpreter;
***************
*** 110,200 ****
#/**
! # Marks the current node in the source document.
! # Returns an ID which can be used to retrieve
! # the node.
! # @return a scalar holding an ID
# @public
#*/
! sub markCurrentSource {
my ( $this ) = @_;
! $this -> markNode( $this -> currentSource() );
}
#/**
! # Marks the current node in the Target document.
! # Returns an ID which can be used to retrieve
! # the node.
! # @return a scalar holding an ID
# @public
#*/
! sub markCurrentTarget {
my ( $this ) = @_;
! $this -> markNode( $this -> currentTarget() );
}
#/**
! # Marks the given node.
# @param an instance of <code>XML::DOM2::Node</code>
! # @return an ID which can be used to retrieve the node.
! # @public
#*/
! sub markNode {
! my ( $this, $node ) = @_;
! my $uid = $this -> interpreter() -> getUID();
! $this -> { m_markedNodes } -> { $uid } = $node;
! $uid;
}
#/**
! # Returns a marked node.
! # @param an ID for the previously marked node.
! # @return an instance of <code>XML::DOM2::Node</code>
# @public
#*/
! sub markedNode {
! my ( $this, $uid ) = @_;
! $this -> { m_markedNodes } -> { $uid };
}
#/**
! # Removes a mark from a node.
! # @param an ID for the previously marked node.
! # @public
#*/
! sub clearMark {
! my ($this, $uid) = @_;
! delete ( $this -> { m_markedNodes } -> { $uid } );
}
#/**
! # Retrieves or sets the current node in the source document.
! # @optional an instance of <code>XML::DOM2::Node</code>
! # @return an instance of <code>XML::DOM2::Node</code>
# @public
#*/
! sub currentSource {
! my ( $this, $newNode ) = @_;
! if ( defined( $newNode ) ) {
! $this -> { m_currentSourceNode } = $newNode;
! }
! $this -> { m_currentSourceNode };
}
-
#/**
! # Retrieves or sets the current node in the target document.
! # @optional an instance of <code>XML::DOM2::Node</code>
! # @return an instance of <code>XML::DOM2::Node</code>
! # @public
#*/
! sub currentTarget {
! my ( $this, $newNode ) = @_;
! if ( defined( $newNode ) ) {
! $this -> { m_currentTargetNode } = $newNode;
! }
! $this -> { m_currentTargetNode };
}
-
#/**
# Inserts a node into the target document. The given node will be cloned
--- 110,192 ----
#/**
! # Retrieves the current node in the source document.
! # @return an instance of <code>XML::DOM2::Node</code>
# @public
#*/
! sub currentSource {
my ( $this ) = @_;
! $this -> { m_currentSourceNode };
}
#/**
! # Sets the current source node.
! # @optional an instance of <code>XML::DOM2::Node</code>
! # @private
! #*/
! sub setCurrentSource {
! my ( $this, $newNode ) = @_;
! $this -> { m_currentSourceNode } = $newNode;
! $this -> { m_sourceNodeChanged } = 1;
! }
!
! #/**
! # Retrieves the current node in the target document.
! # @return an instance of <code>XML::DOM2::Node</code>
# @public
#*/
! sub currentTarget {
my ( $this ) = @_;
! $this -> { m_currentTargetNode };
}
#/**
! # Sets the current node in the target document.
# @param an instance of <code>XML::DOM2::Node</code>
! # @private
#*/
! sub setCurrentTarget {
! my ( $this, $newNode ) = @_;
! $this -> { m_currentTargetNode } = $newNode;
}
+
#/**
! # Returns the document node of the source document.
# @public
#*/
! sub sourceDocument {
! my ($this) = @_;
! $this -> { m_sourceDocument };
}
#/**
! # Sets the source document.
! # @param an instance of <code>XML::DOM2::Document</code>
! # @private
#*/
! sub setSourceDocument {
! my ( $this, $document ) = @_;
! $this -> { m_sourceDocument } = $document;
}
#/**
! # Returns the target document.
# @public
#*/
! sub targetDocument {
! my ( $this ) = @_;
! $this -> { m_targetDocument };
}
#/**
! # Sets the target document.
! # @param an instance of <code>XML::DOM2::Document</code>
! # @private
#*/
! sub setTargetDocument {
! my ( $this, $document ) = @_;
! $this -> { m_targetDocument } = $document;
}
#/**
# Inserts a node into the target document. The given node will be cloned
***************
*** 211,218 ****
sub insertIntoTarget {
my ( $this, $node, $isRefNode ) = @_;
- my $currentNode = $this -> currentTarget();
- my $document = $currentNode -> ownerDocument();
$this -> basicStatement() -> init(
! $this -> interpreter(), $node, $document );
my $clone = $this -> basicStatement() -> evaluate();
--- 203,208 ----
sub insertIntoTarget {
my ( $this, $node, $isRefNode ) = @_;
$this -> basicStatement() -> init(
! $this -> interpreter(), $node, $this -> targetDocument() );
my $clone = $this -> basicStatement() -> evaluate();
***************
*** 226,240 ****
if ( $clone -> nodeType() == $XML::DOM2::Node::ELEMENT_NODE &&
$isRefNode ) {
! $this -> currentTarget( $clone ) ;
}
}
#/**
! # @return an instance of <code>NetScript::Interpreter</code>
! # @public
#*/
! sub interpreter {
! my ( $this ) = @_;
! $this -> { m_interpreter };
}
--- 216,234 ----
if ( $clone -> nodeType() == $XML::DOM2::Node::ELEMENT_NODE &&
$isRefNode ) {
! $this -> setCurrentTarget( $clone ) ;
}
}
#/**
! # Returns, if the source node was changed. On retrieval,
! # the flag is reset to false.
! # @private
! # @return a boolean.
#*/
! sub sourceNodeChanged {
! my ($this) = @_;
! my $result = $this -> { m_sourceNodeChanged };
! $this -> { m_sourceNodeChanged } = 0;;
! $result;
}
***************
*** 247,251 ****
sub walkOver {
my ( $this, $source ) = @_;
! $this -> currentSource( $source );
my $di = XML::DOM2::DOMImplementation -> new();
# create target document
--- 241,245 ----
sub walkOver {
my ( $this, $source ) = @_;
! $this -> setCurrentSource( $source );
my $di = XML::DOM2::DOMImplementation -> new();
# create target document
***************
*** 259,264 ****
} );
! $this -> currentTarget( $document );
!
$this -> goWalk();
# Return result document
--- 253,260 ----
} );
! $this -> setCurrentTarget( $document );
! $this -> setSourceDocument( $source );
! $this -> setTargetDocument( $document );
!
$this -> goWalk();
# Return result document
***************
*** 267,299 ****
#/**
! # Walks over the document. The walking is depth-first. The walker
! # will create an event for the current source node, then will iterate
! # over the children of the current source node in a depth-first manner.
# @private
#*/
sub goWalk {
my ( $this ) = @_;
- my $node = $this -> currentSource();
-
-
- # create start Event
- $this -> createEvent( $node );
- my $children = $node -> childNodes();
- my $count = $children -> length() - 1;
! # iterate over the children
! for ( 0..$count ) {
! $this -> currentSource( $children -> item ( {
! index => $_
! }));
! $this -> goWalk();
}
!
! # set old node as currentNode
! $this -> currentSource( $node );
! $this -> createEndEvent( $node );
! }
#/**
--- 263,391 ----
#/**
! # Walks over the document. As long there is a current source
! # node it will generate an event for this node.
# @private
#*/
sub goWalk {
my ( $this ) = @_;
! while ( $this -> currentSource() ) {
! $this -> createEvent( $this -> currentSource() );
! }
! }
!
! #/**
! # Keeps the current source node as current source node
! # executing it again.
! #*/
! sub sourceAgain {
! my ( $this ) = @_;
! $this -> setCurrentSource( $this -> currentSource() );
! }
!
! #/**
! # Performs a depth-first step from the current source node
! # to the next node. It will first try to get the first child
! # of the node. If this node has no more children, the method
! # will set the next sibling of the current source node as
! # new current source node. If the current source node has no
! # next sibling, the method will set the next sibling of the
! # current source node's parent as new current source node. If
! # the current source node has no parent the method will
! # set the current source node to <code>undef</code>
! # @public
! #*/
! sub stepSourceIn {
! my ($this) = @_;
! my $source = $this -> currentSource();
! my $nextSource = undef;
! if ( $source ) {
! $nextSource = $source -> firstChild();
! unless ( $nextSource ) {
! $this -> stepSourceNext();
! }
! else {
! $this -> setCurrentSource( $nextSource );
! }
}
! }
! #/**
! # Steps up to the parent of the current source node. No events
! # are raised!.
! # @public
! #*/
! sub stepSourceUp {
! my ($this) = @_;
! my $source -> $this -> currentSource();
! $this -> setCurrentSource( $source -> parentNode() );
! }
!
! #/**
! # Goes one step up in the target tree.
! # @public
! #*/
! sub stepTargetUp {
! my ( $this ) = @_;
! my $target = $this -> currentTarget();
! $this -> setCurrentTarget( $target -> parentNode() );
! }
!
! #/**
! # This sub advances the current source node to its
! # next sibling. If the current source node has no
! # next sibling, it will advance to the next sibling
! # of it's parent node.
! # @public
! #*/
! sub stepSourceNext {
! my ( $this ) = @_;
! my $source = $this -> currentSource();
!
! if ( $source ) {
! my $nextSource = $source -> nextSibling();
! unless ( $nextSource ) {
! my $parent = $source -> parentNode();
! while ( defined( $parent ) && !defined( $nextSource ) ) {
! $nextSource = $parent -> nextSibling();
! unless( $nextSource ) {
! # parent is finished
! $this -> finishNode( $parent );
! if ( $this -> sourceNodeChanged() ) {
! return; # stop processing
! }
! $parent = $parent -> parentNode();
! }
! else {
! # parent is finished
! $this -> finishNode( $parent );
! if ( $this -> sourceNodeChanged() ) {
! return; # stop processing
! }
! }
! }
! }
! else {
! $this -> finishNode( $source );
! if ( $this -> sourceNodeChanged() ) {
! return; # stop processing
! }
! }
! $this -> setCurrentSource( $nextSource );
! }
! }
+ #/**
+ # Sets the given node as current source and creates
+ # an end event for the given node.
+ # @private
+ # @param an instance of <code>XML::DOM2::Node</code>
+ #*/
+ sub finishNode {
+ my ($this, $node) = @_;
+ $this -> setCurrentSource($node);
+ $this -> sourceNodeChanged();
+ $this -> createEndEvent( $node );
+ }
#/**
***************
*** 360,363 ****
--- 452,465 ----
$this -> { m_basicStatement };
}
+
+ #/**
+ # @return an instance of <code>NetScript::Interpreter</code>
+ # @public
+ #*/
+ sub interpreter {
+ my ( $this ) = @_;
+ $this -> { m_interpreter };
+ }
+
1; # make require happy
Index: Event.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/Event.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** Event.pm 11 May 2002 13:08:20 -0000 1.5
--- Event.pm 15 May 2002 18:21:37 -0000 1.6
***************
*** 1,10 ****
#--------------------------------------------------------
! # This class represents an event within the interpreter.
! # An event is used to report special conditions to the interpreter
! # or attached libraries. E.g it is used for error handling within
! # the interpreter.
# $Id$
#
- # Class Event
# NetScript and all related materials, such as documentation,
# are protected under the terms and conditions of the Artistic License.
--- 1,6 ----
#--------------------------------------------------------
! # NetScript 2
# $Id$
#
# NetScript and all related materials, such as documentation,
# are protected under the terms and conditions of the Artistic License.
***************
*** 13,23 ****
#--------------------------------------------------------
use strict;
package NetScript::Engine::Event;
- #--------------------------------------------------------
- # Globals
- #--------------------------------------------------------
- our $VERSION = '1.0';
#/**
--- 9,22 ----
#--------------------------------------------------------
use strict;
+
+ #/**
+ # This class represents an event within the interpreter.
+ # An event is used to report special conditions to the interpreter
+ # or attached libraries. E.g it is used for error handling within
+ # the interpreter.
+ #*/
package NetScript::Engine::Event;
#/**
***************
*** 79,82 ****
--- 78,82 ----
return $this -> { m_EventUnknown };
}
+
Index: EventListener.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/EventListener.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** EventListener.pm 11 May 2002 13:08:20 -0000 1.2
--- EventListener.pm 15 May 2002 18:21:37 -0000 1.3
***************
*** 2,6 ****
# $Id$
#
- # Class EventListener
# NetScript and all related materials, such as documentation,
# are protected under the terms and conditions of the Artistic License.
--- 2,5 ----
***************
*** 27,31 ****
# Globals
#--------------------------------------------------------
! our $VERSION = '1.0';
#/**
--- 26,30 ----
# Globals
#--------------------------------------------------------
!
#/**
Index: EventRelay.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/EventRelay.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** EventRelay.pm 11 May 2002 13:08:20 -0000 1.6
--- EventRelay.pm 15 May 2002 18:21:37 -0000 1.7
***************
*** 2,6 ****
# $Id$
#
- # Class EventRelay
# NetScript and all related materials, such as documentation,
# are protected under the terms and conditions of the Artistic License.
--- 2,5 ----
***************
*** 33,37 ****
# Globals
#--------------------------------------------------------
! our $VERSION = '1.0';
#/**
--- 32,36 ----
# Globals
#--------------------------------------------------------
!
#/**
***************
*** 144,154 ****
# save the new event and return. the new event
# will be sent after the current event was sent.
! if ( $this -> { m_deliveringEvents } ) {
! push( @{$this -> { m_pendingEvents }}, $event );
! return;
! }
# now we deliver events
! $this -> { m_deliveringEvents } = 1;
my $arrayRef = $this -> { m_EventListeners } ->
--- 143,153 ----
# save the new event and return. the new event
# will be sent after the current event was sent.
! # if ( $this -> { m_deliveringEvents } ) {
! # push( @{$this -> { m_pendingEvents }}, $event );
! # return;
! # }
# now we deliver events
! # $this -> { m_deliveringEvents } = 1;
my $arrayRef = $this -> { m_EventListeners } ->
***************
*** 165,174 ****
# we have delivered the current event.
! $this -> { m_deliveringEvents } = 0;
# now lets look if there are some events in the queue
! my $nextEvent = shift( @{$this -> { m_pendingEvents }} );
# if there is one, deliver it.
! $this -> raiseEvent( $nextEvent ) if defined($nextEvent);
}
--- 164,173 ----
# we have delivered the current event.
! # $this -> { m_deliveringEvents } = 0;
# now lets look if there are some events in the queue
! # my $nextEvent = shift( @{$this -> { m_pendingEvents }} );
# if there is one, deliver it.
! # $this -> raiseEvent( $nextEvent ) if defined($nextEvent);
}
Index: State.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/State.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** State.pm 11 May 2002 13:08:20 -0000 1.3
--- State.pm 15 May 2002 18:21:37 -0000 1.4
***************
*** 17,21 ****
# Globals
#--------------------------------------------------------
! our $VERSION = '1.0';
#/**
--- 17,21 ----
# Globals
#--------------------------------------------------------
!
#/**
***************
*** 55,60 ****
sub setParent {
my ($this, $parent) = @_;
-
- #FIXME: Errorhandling, if parent is not defined.
$this -> { m_ParentState } = $parent;
}
--- 55,58 ----
***************
*** 207,211 ****
# variable is not defined.
#*/
! sub getVariableValue {
my ( $this, $array, $index ) = @_;
--- 205,209 ----
# variable is not defined.
#*/
! sub getArrayValue {
my ( $this, $array, $index ) = @_;
Index: Statement.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/Statement.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** Statement.pm 11 May 2002 13:08:20 -0000 1.4
--- Statement.pm 15 May 2002 18:21:37 -0000 1.5
***************
*** 2,6 ****
# $Id$
#
- # Class Statement
# NetScript and all related materials, such as documentation,
# are protected under the terms and conditions of the Artistic License.
--- 2,5 ----
***************
*** 21,25 ****
# Globals
#--------------------------------------------------------
! our $VERSION = '1.0';
#/**
--- 20,24 ----
# Globals
#--------------------------------------------------------
!
#/**
Index: StatementEvaluator.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/StatementEvaluator.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** StatementEvaluator.pm 11 May 2002 13:08:20 -0000 1.4
--- StatementEvaluator.pm 15 May 2002 18:21:37 -0000 1.5
***************
*** 2,6 ****
# $Id$
#
- # Class Class
# NetScript and all related materials, such as documentation,
# are protected under the terms and conditions of the Artistic License.
--- 2,5 ----
***************
*** 24,28 ****
# Globals
#--------------------------------------------------------
! our $VERSION = '1.0';
--- 23,27 ----
# Globals
#--------------------------------------------------------
!
|
