[NetScript CVS] CVS: netscript2/src/perl/NetScript/Libraries ControlStructuresLibrary.pm,NONE,1.1 DebugLibrary.pm,1.2,1.3 DefaultLibrary.pm,1.2,1.3 Library.pm,1.2,1.3

[Jan T. <de...@us...>]

Update of /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries
In directory usw-pr-cvs1:/tmp/cvs-serv17690

Modified Files:
	DebugLibrary.pm DefaultLibrary.pm Library.pm 
Added Files:
	ControlStructuresLibrary.pm 
Log Message:
* added ControlStructuresLibrary

--- NEW FILE: ControlStructuresLibrary.pm ---
#--------------------------------------------------------
# $Id: ControlStructuresLibrary.pm,v 1.1 2002/05/15 18:22:18 derkork Exp $
# 
# 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 control structures library enables some basic control structures
# as a WHILE and FOR-loop and an IF/ELSE-statement.
# Usage in your NetScripts is as follows. The IF-statement
# <pre>
#
#   &lt;ns:if test="[some boolean value here]"&gt;
#       This test was true
#   &lt;/ns:if&gt;
#   &lt;ns:else&gt;
#       This test was false
#   &lt;/ns:else&gt;    
# </pre>
# The loops:
# <pre>
#
#   &lt;ns:while test="[some boolean value here]"&gt;
#       [while-block here]
#   &lt;/ns:while&gt;
#
#   &lt;ns:for var="[counter variable]" from="[start value]" to="[end value]"&gt;
#       [for-block here]
#   &lt;/ns:for&gt;
#       
# </pre>
#*/
package NetScript::Libraries::ControlStructuresLibrary;
use base qw(NetScript::Libraries::Library);



use NetScript::Libraries::DebugLibrary;
use NetScript::Engine::EventListener;
use NetScript::Engine::EventRelay;
use NetScript::Interpreter;
use NetScript::Engine::DOMWalker;

#/**
# Ctor. 
# @public
#*/
sub new {
    my $proto = shift;                  # get Prototype
    my $class = ref($proto) || $proto;
    my $this = $class -> SUPER::new();
    my %forLoops = ();
    $this -> { m_forLoops } = \%forLoops;
    $this;
    }


sub init {
    my ($this, $interpreter) = @_;
    $this -> SUPER::init( $interpreter );
    # create event listeners for all events

    my $eventListener1 = NetScript::Engine::EventListener -> new();
    $eventListener1 -> init( 
            $NetScript::Engine::DOMWalker::ELEMENT_START_EVENT,
            "elementStarted", $this );

    my $eventListener2 = NetScript::Engine::EventListener -> new();
    $eventListener2 -> init( 
            $NetScript::Engine::DOMWalker::ELEMENT_END_EVENT,
            "elementFinished", $this );
    my $eventRelay = $this -> interpreter() -> getEventRelay();
    $eventRelay -> addEventListener( $eventListener1 );
    $eventRelay -> addEventListener( $eventListener2 );
    }

#/**
# Called upon element start
# @callback
#*/
sub elementStarted {
    my ( $this, $event ) = @_;
    my $domWalker = $event -> eventUnknown();
    my $node = $domWalker -> currentSource();
    if ( $node -> namespaceURI() eq $NetScript::Interpreter::NAMESPACE_URI ) {
        if ($node -> localName() eq "if") {
            $this -> ifStart( $domWalker, $node );
            0; # consume event
            }
        elsif( $node -> localName() eq "else" ) {
            $this -> elseStart( $domWalker, $node );
            0; # consume event
            }
        elsif ($node -> localName() eq "while" ) {
            $this -> whileStart( $domWalker, $node );
            0; # consume event
            }
        elsif ($node -> localName() eq "for" ) {
            $this -> forStart( $domWalker, $node );
            0; # consume event
            }
        else {
            1; # do not consume event
            }
        }
    else {
        1; # do not consume event
        }
    }

#/**
# Checks the test-attribute of the given element node
# for being true or false.
# @private
# @param an instance of <code>XML::DOM2::Element</code>
#*/
sub checkNodeTest {
    my ($this, $node) = @_;
    my $test = $node -> getAttribute( {
        name => "test"
        });
    # replace variables
    my $se = $this -> interpreter() -> getStatementEvaluator();
    $test = $se -> evaluateStatement( $test );
    eval( $test );
    }

#/**
# Called upon the start of an if-node.
# @param an instance of NetScript::Engine::DOMWalker
# @param the if-node (XML::DOM2::Element)
# @private
#*/
sub ifStart {
    my ( $this, $domWalker, $node ) = @_;
    # check condition
    unless ( $this -> checkNodeTest( $node ) ) {
        # test did not succeed, so we jump to the next sibling if any        
        $domWalker -> stepSourceNext();
        }
    else {
        # condition is true, proceed as usual
        $domWalker -> stepSourceIn();
        }
    }

#/**
# Called upon the start of an else-node.
# @param an instance of NetScript::Engine::DOMWalker
# @param the if-node (XML::DOM2::Element)
# @private
#*/
sub elseStart {
    my ( $this, $domWalker, $node ) = @_;
    # find the belonging IF-Node
    my $ifNode = $node -> previousSibling();

    # skip text nodes
    while ( $ifNode && $ifNode -> nodeType() == $XML::DOM2::Node::TEXT_NODE ) {
        $ifNode = $ifNode -> previousSibling();
        }

    if ( $ifNode && 
            $ifNode -> namespaceURI() eq 
            $NetScript::Interpreter::NAMESPACE_URI &&
            $ifNode -> localName() eq "if") {
        
        # check condition
        unless ( $this -> checkNodeTest( $ifNode ) ) {
            # test did not succeed, so we proceed with the else case
            $domWalker -> stepSourceIn();
            }
        else {
            # condition is true, proceed as usual
            $domWalker -> stepSourceNext();
            }
        }
    else {
        # FIXME: DO not use DIE
        die "Else without IF" ;
        }
    }   


#/**
# Called upon the start of a while-node.
# @param an instance of NetScript::Engine::DOMWalker
# @param the if-node (XML::DOM2::Element)
# @private
#*/
sub whileStart {
    my ( $this, $domWalker, $node ) = @_;
    # check condition
    if ( $this -> checkNodeTest( $node ) ) {
        # test did not succeed, so we jump to the next sibling if any        
        $domWalker -> stepSourceNext();
        }
    else {
        # condition is true, proceed as usual
        $domWalker -> stepSourceIn();
        }
    }

#/**
# Called upon the end of an while loop.
# @param an instance of NetScript::Engine::DOMWalker
# @param the if-node (XML::DOM2::Element)
# @private
#*/
sub whileEnd {
    my ( $this, $domWalker, $node ) = @_;
    if ( $this -> checkNodeTest( $node ) ) {
        $domWalker -> sourceAgain();        
        }
    # else do nothing
    }


#/**
# Called when a for-loop starts.
# @param an instance of NetScript::Engine::DOMWalker
# @param the if-node (XML::DOM2::Element)
# @private
#*/
sub forStart {
    my ( $this, $domWalker, $node ) = @_;
    

    my $from = $node -> getAttribute({
        name => "from"
        });
    my $to = $node -> getAttribute({
        name => "to"
        });
    
    my $var = $node -> getAttribute({
        name => "var"
        });

    my $value = $this -> { m_forLoops } -> {  $node };

        
    if ( !defined( $value ) )  { # variable is yet unknown so we initialize it
        $value = $from;
        }
    else {
        if ( $from <= $to ) { # step up if from is <= to
            $value ++;
            }
        else {                # step down otherwise
            $value --;
            }
        }
    # create new state

    $this -> interpreter() -> newState();
    # set variable 
    $this -> interpreter() -> getState() -> setVariableValue(
        $var, $value );
    $this -> { m_forLoops } -> { $node } = $value;

    if ( ( $from <= $to &&  $value > $to ) ||
         ( $from > $to &&  $value < $to ) )  { # check if loop should be executed
        # no it should not, skip node
        $domWalker -> stepSourceNext();
        }
    else {
        # it should, proceed in
        $domWalker -> stepSourceIn();
        }
    }

#/**
# Called when a for-loop ends..
# @param an instance of NetScript::Engine::DOMWalker
# @param the if-node (XML::DOM2::Element)
# @private
#*/
sub forEnd {
    my ($this, $domWalker, $node) = @_;
    my $from = $node -> getAttribute({
        name => "from"
        });
    my $to = $node -> getAttribute({
        name => "to"
        });
    
    my $var = $node -> getAttribute({
        name => "var"
        });

    my $value = $this -> interpreter() -> getState() ->
        getVariableValue( $var );
        
    $this -> interpreter() -> dropState();
    if ( ( $from <= $to &&  $value <= $to ) ||
         ( $from > $to &&  $value >= $to ) )  { # check if loop should be executed
        # in case that the user has changed the value
        $this -> { m_forLoops } -> { $node } = $value;
        $domWalker -> sourceAgain();
        }
    else {
        delete $this -> { m_forLoops } ->  { $node };
        }
    }

#/**
# Called upon element finish.
#*/
sub elementFinished {
    my ( $this, $event ) = @_;
    my $domWalker = $event -> eventUnknown();
    my $node = $domWalker -> currentSource();
    if ( $node -> namespaceURI() eq $NetScript::Interpreter::NAMESPACE_URI ) {
        if ($node -> localName() eq "if") {
            # nothing to do, but event MUST be consumed
            0; # consume event 
            }
        elsif ($node -> localName() eq "else") {
            # nothing to do, but event MUST be consumed
            0; # consume event 
            }
        elsif ($node -> localName() eq "while" ) {
            $this -> whileEnd( $domWalker, $node );
            0; # consume event
            }
        elsif ($node -> localName() eq "for" ) {
            $this -> forEnd( $domWalker, $node );
            0; # consume event
            }
        else {
            1; # do not consume event
            }
        }
    else {
        1; # do not consume event
        }
    }


sub shutdown {
    my ($this) = @_;
    $this -> SUPER::shutdown();
    }


#/**
# Sends a debug event.
# @param the debug message
# @private
#*/
sub debug {
    my ($this, $message) = @_;
    $this -> interpreter() -> getEventRelay() ->
            createAndRaiseEvent( 
            $NetScript::Libraries::DebugLibrary::DEBUG_EVENT,
            $message,
            "Control" 
            );
    }
1; #make require happy


Index: DebugLibrary.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/DebugLibrary.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** DebugLibrary.pm	11 May 2002 13:13:10 -0000	1.2
--- DebugLibrary.pm	15 May 2002 18:22:18 -0000	1.3
***************
*** 2,6 ****
  # $Id$
  #
- # Class DebugLibrary
  # 
  # NetScript and all related materials, such as documentation,
--- 2,5 ----
***************
*** 18,22 ****
  use base qw(NetScript::Libraries::Library);
  
! our $VERSION = '1.0';
  
  our $DEBUG_EVENT = "DEBUG_LIBRARY_DEBUG_EVENT";
--- 17,21 ----
  use base qw(NetScript::Libraries::Library);
  
! 
  
  our $DEBUG_EVENT = "DEBUG_LIBRARY_DEBUG_EVENT";
***************
*** 67,71 ****
      my ( $this, $event ) = @_;
      my $domWalker = $event -> eventUnknown();
!     my $document = $domWalker -> currentSource() -> ownerDocument();
      my $comment = $document -> createComment( { 
              data => $this -> debugMessage() 
--- 66,70 ----
      my ( $this, $event ) = @_;
      my $domWalker = $event -> eventUnknown();
!     my $document = $domWalker -> sourceDocument();
      my $comment = $document -> createComment( { 
              data => $this -> debugMessage() 

Index: DefaultLibrary.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/DefaultLibrary.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** DefaultLibrary.pm	11 May 2002 13:09:03 -0000	1.2
--- DefaultLibrary.pm	15 May 2002 18:22:18 -0000	1.3
***************
*** 2,6 ****
  # $Id$
  #
- # Class DefaultLibrary
  # 
  # NetScript and all related materials, such as documentation,
--- 2,5 ----
***************
*** 20,24 ****
  use base qw(NetScript::Libraries::Library);
  
! our $VERSION = '1.0';
  
  use NetScript::Engine::EventListener;
--- 19,23 ----
  use base qw(NetScript::Libraries::Library);
  
! 
  
  use NetScript::Engine::EventListener;
***************
*** 35,40 ****
      my $class = ref($proto) || $proto;
      my $this = $class -> SUPER::new();
-     my @elemStack = ();
-     $this -> { m_elemStack } = \@elemStack;
      $this;
      }
--- 34,37 ----
***************
*** 82,85 ****
--- 79,89 ----
             $NetScript::Engine::EventListener::PRIORITY_LAST );
  
+     my $eventListener7 = NetScript::Engine::EventListener -> new();
+     $eventListener7 -> init( 
+             $NetScript::Engine::DOMWalker::DOCUMENT_START_EVENT,
+             "documentStarted", $this, 
+            $NetScript::Engine::EventListener::PRIORITY_LAST );
+ 
+ 
      my $eventRelay = $this -> interpreter() -> getEventRelay();
      $eventRelay -> addEventListener( $eventListener1 );
***************
*** 89,92 ****
--- 93,97 ----
      $eventRelay -> addEventListener( $eventListener5 );
      $eventRelay -> addEventListener( $eventListener6 );
+     $eventRelay -> addEventListener( $eventListener7 );
      }
  
***************
*** 101,104 ****
--- 106,110 ----
      my $node = $domWalker -> currentSource();
      $domWalker -> insertIntoTarget( $node, 1 );
+     $domWalker -> stepSourceIn();
      0; # consume event
      }
***************
*** 112,117 ****
      my ($this, $event) = @_;
      my $domWalker = $event -> eventUnknown();
-     my $id = $domWalker -> markCurrentTarget();
-     push( @{$this -> { m_elemStack }}, $id );
      $this -> copyNode( $event );
      0; # consume event
--- 118,121 ----
***************
*** 126,135 ****
      my ($this, $event) = @_;
      my $domWalker = $event -> eventUnknown();
!     my $id = pop( @{$this -> { m_elemStack }} );
!     my $node = $domWalker -> markedNode( $id );
!     $domWalker -> currentTarget( $node );
!     $domWalker -> clearMark( $id );
      0; # consume event
      }
  
  sub shutdown {
--- 130,149 ----
      my ($this, $event) = @_;
      my $domWalker = $event -> eventUnknown();
!     $domWalker -> stepTargetUp();
      0; # consume event
      }
+ 
+ 
+ #/**
+ # Called, if the document is started.
+ # @callback
+ #*/
+ sub documentStarted {
+     my ($this, $event) = @_;
+     my $domWalker = $event -> eventUnknown();
+     $domWalker -> stepSourceIn();
+     }
+ 
+ 
  
  sub shutdown {

Index: Library.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/Library.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** Library.pm	11 May 2002 13:09:03 -0000	1.2
--- Library.pm	15 May 2002 18:22:18 -0000	1.3
***************
*** 22,26 ****
  
  
! our $VERSION = '1.0';
  
  #/**
--- 22,26 ----
  
  
! 
  
  #/**
***************
*** 71,74 ****
--- 71,75 ----
      $this -> { m_interpreter };
      }
+ 
  
  1; #make require happy