[NetScript CVS] CVS: netscript2/src/perl/NetScript/Engine BasicStatement.pm,1.6,1.7 DOMWalker.pm,1.5,1.6 State.pm,1.5,1.6 StatementEvaluator.pm,1.7,1.8

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

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

Modified Files:
	BasicStatement.pm DOMWalker.pm State.pm StatementEvaluator.pm 
Log Message:
* added checks for variable existence
* added distinction between creating a variable and altering it

Index: BasicStatement.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/BasicStatement.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** BasicStatement.pm	2 Jun 2002 19:31:23 -0000	1.6
--- BasicStatement.pm	9 Jun 2002 12:50:04 -0000	1.7
***************
*** 72,96 ****
  
      # clone the node into the new document
!     my $newNode = $document -> importNode( { importedNode => $node, deep => 0 } );
  
      # 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() -1;
          for ( 0..$length ) { 
!             my $attribute = $attributes -> item( { index => $_ } );
!             my $value = $attribute -> value();
!             my $name = $attribute -> nodeName();
              $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 } );
          }
  
--- 72,96 ----
  
      # clone the node into the new document
!     my $newNode = $document -> importNode( $node, 0 );
  
      # Check for the Node Type. 
!     if ( $newNode -> getNodeType() == $XML::DOM2::Node::ELEMENT_NODE ) {
          # attributes in elements will be checked for variables
!         my $attributes = $newNode -> getAttributes();
!         my $length = $attributes -> getLength() -1;
          for ( 0..$length ) { 
!             my $attribute = $attributes -> item( $_ );
!             my $value = $attribute -> getValue();
!             my $name = $attribute -> getNodeName();
              $value = $interpreter -> getStatementEvaluator() 
                      -> evaluateStatement( $value );
!             $attribute -> setValue( $value );
              }
          }
!     elsif ( $newNode -> getNodeType() == $XML::DOM2::Node::TEXT_NODE ) {
!         my $text = $newNode -> getData();
          $text = $interpreter -> getStatementEvaluator() 
                  -> evaluateStatement( $text );
!         $newNode -> setData( $text );
          }
  

Index: DOMWalker.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/DOMWalker.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** DOMWalker.pm	2 Jun 2002 19:31:23 -0000	1.5
--- DOMWalker.pm	9 Jun 2002 12:50:04 -0000	1.6
***************
*** 213,222 ****
      
      # append clone to document
!     $this -> currentTarget() -> appendChild( {
!         newChild => $clone
!         });
     
      # set current target node to new node
!     if ( $clone -> nodeType() == $XML::DOM2::Node::ELEMENT_NODE && 
           $isRefNode ) {
          $this -> setCurrentTarget( $clone ) ;
--- 213,220 ----
      
      # append clone to document
!     $this -> currentTarget() -> appendChild( $clone );
     
      # set current target node to new node
!     if ( $clone -> getNodeType() == $XML::DOM2::Node::ELEMENT_NODE && 
           $isRefNode ) {
          $this -> setCurrentTarget( $clone ) ;
***************
*** 248,259 ****
      my $di = XML::DOM2::DOMImplementation -> new();
      # create target document
!     my $document = $di -> createDocument( {
!         namespaceURI => "dummy",
!         qualifiedName => "dummy:dummy"
!         } );
      # remove document element
!     $document -> removeChild( {
!         oldChild => $document -> documentElement()
!         } );
      
      $this -> setCurrentTarget( $document );
--- 246,253 ----
      my $di = XML::DOM2::DOMImplementation -> new();
      # create target document
!     my $document = $di -> createDocument(
!         "dummy", "dummy:dummy" );
      # remove document element
!     $document -> removeChild( $document -> getDocumentElement() );
      
      $this -> setCurrentTarget( $document );
***************
*** 305,309 ****
      my $nextSource = undef;
      if ( $source ) {
!         $nextSource = $source -> firstChild();
          unless ( $nextSource ) {
              $this -> stepSourceNext();
--- 299,303 ----
      my $nextSource = undef;
      if ( $source ) {
!         $nextSource = $source -> getFirstChild();
          unless ( $nextSource ) {
              $this -> stepSourceNext();
***************
*** 323,327 ****
      my ($this) = @_;
      my $source = $this -> currentSource();
!     $this -> setCurrentSource( $source -> parentNode() );
      }
  
--- 317,321 ----
      my ($this) = @_;
      my $source = $this -> currentSource();
!     $this -> setCurrentSource( $source -> getParentNode() );
      }
  
***************
*** 333,337 ****
      my ( $this ) = @_;
      my $target = $this -> currentTarget();
!     $this -> setCurrentTarget( $target -> parentNode() );
      }
  
--- 327,331 ----
      my ( $this ) = @_;
      my $target = $this -> currentTarget();
!     $this -> setCurrentTarget( $target -> getParentNode() );
      }
  
***************
*** 348,356 ****
  
      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   
--- 342,350 ----
  
      if ( $source ) {
!         my $nextSource = $source -> getNextSibling();
          unless ( $nextSource ) {
!             my $parent = $source -> getParentNode();
              while ( defined( $parent ) && !defined( $nextSource ) ) {
!                 $nextSource = $parent -> getNextSibling();
                  unless( $nextSource ) {
                      # parent is finished   
***************
*** 359,363 ****
                          return; # stop processing
                          }
!                     $parent = $parent -> parentNode();
                      }
                  else {
--- 353,357 ----
                          return; # stop processing
                          }
!                     $parent = $parent -> getParentNode();
                      }
                  else {
***************
*** 400,404 ****
  sub createEvent {
      my ( $this, $node ) = @_;
!     my $nodeType = $node -> nodeType();
      my $eventType;
      if ( $nodeType == $XML::DOM2::Node::ELEMENT_NODE ) {
--- 394,398 ----
  sub createEvent {
      my ( $this, $node ) = @_;
!     my $nodeType = $node -> getNodeType();
      my $eventType;
      if ( $nodeType == $XML::DOM2::Node::ELEMENT_NODE ) {
***************
*** 431,440 ****
  sub createEndEvent {
      my ( $this, $node ) = @_;
!     my $nodeType = $node -> nodeType();
      my $eventType;
!     if ($node -> nodeType == $XML::DOM2::Node::ELEMENT_NODE ) {
          $eventType =  $NetScript::Engine::DOMWalker::ELEMENT_END_EVENT;
          }
!     elsif ( $node -> nodeType == $XML::DOM2::Node::DOCUMENT_NODE ) {
          $eventType = $NetScript::Engine::DOMWalker::DOCUMENT_END_EVENT;
          }
--- 425,434 ----
  sub createEndEvent {
      my ( $this, $node ) = @_;
!     my $nodeType = $node -> getNodeType();
      my $eventType;
!     if ($nodeType == $XML::DOM2::Node::ELEMENT_NODE ) {
          $eventType =  $NetScript::Engine::DOMWalker::ELEMENT_END_EVENT;
          }
!     elsif ( $nodeType == $XML::DOM2::Node::DOCUMENT_NODE ) {
          $eventType = $NetScript::Engine::DOMWalker::DOCUMENT_END_EVENT;
          }

Index: State.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/State.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** State.pm	29 May 2002 20:26:17 -0000	1.5
--- State.pm	9 Jun 2002 12:50:04 -0000	1.6
***************
*** 40,46 ****
--- 40,52 ----
      my %arrays = ();
      my %objects = ();
+     my %variablesFlags = ();
+     my %arraysFlags = ();
+     my %objectsFlags = ();
      $this -> { m_Variables } = \%variables;
      $this -> { m_Arrays } = \%arrays;
      $this -> { m_Objects } = \%objects;
+     $this -> { m_VariablesFlags } = \%variablesFlags;
+     $this -> { m_ObjectsFlags } = \%objectsFlags;
+     $this -> { m_ArraysFlags } = \%arraysFlags;
  
      # Set parent if parent is defined.
***************
*** 154,157 ****
--- 160,164 ----
  # @param a string containing the variable name.
  # @param a scalar containing the variable value
+ # @return nonzero on successful setting, zero if variable did not exist
  #*/
  sub setVariableValue {
***************
*** 164,171 ****
          # Yes another one has it.
          $variableHolder -> setVariableValue( $variable, $value );
          }
!     else {  # no one has it, so we define it ourselves.
          $this -> { m_Variables } -> { $variable } = $value ;
          }
      }
  
--- 171,201 ----
          # Yes another one has it.
          $variableHolder -> setVariableValue( $variable, $value );
+         return 1;
          }
!     elsif ( defined($variableHolder) ) {
          $this -> { m_Variables } -> { $variable } = $value ;
          }
+     return 0;
+     }
+ 
+ #/**
+ # Creates the given variable with the given value.
+ # @param a string containing the variable name.
+ # @param a scalar containing the variable value
+ # @return nonzero on successful creation, zero if
+ # variable already exists.
+ #*/
+ sub createVariableValue {
+     my ( $this, $name, $value ) = @_;
+     # check if a parent state already knows this 
+     # variable.
+     my $variableHolder = $this -> variableExists( $name );
+     
+     unless( defined( $variableHolder ) ) {
+         # no one has it, so we define it ourselves.
+         $this -> { m_Variables } -> { $name } = $value ;
+         return 1;
+         }
+     return 0;
      }
  
***************
*** 196,200 ****
  # @param a scalar containing the array index
  # @param a scalar containing the value
! # 
  #*/
  sub setArrayValue {
--- 226,231 ----
  # @param a scalar containing the array index
  # @param a scalar containing the value
! # @return nonzero on successfully setting the value,
! #   zero if the array didnt exist.
  #*/
  sub setArrayValue {
***************
*** 208,221 ****
          # Yes another one has it.
          $variableHolder -> setArrayValue( $array, $index, $value );
          }
      elsif (defined( $variableHolder ) ) {  #array exists in this state
          $this -> { m_Arrays } -> { $array } -> [$index] = $value;
          }
!     else { # array does not exist at all.
          my @newArray = ();
          $newArray[$index] = $value;
          $this -> { m_Arrays } -> { $array } = \@newArray;
          }
      }
      
  #/**
--- 239,279 ----
          # Yes another one has it.
          $variableHolder -> setArrayValue( $array, $index, $value );
+         return 1;
          }
      elsif (defined( $variableHolder ) ) {  #array exists in this state
          $this -> { m_Arrays } -> { $array } -> [$index] = $value;
+         return 1;
          }
!     else {
!         return 0;
!         }
!     }
! 
! #/**
! # Creates the given array entry. 
! # @param a string containing the array name.
! # @param a scalar containing the array index
! # @param a scalar containing the value
! # @return nonzero on successfully creating the array,
! #   zero if the array already exists.
! #*/
! sub createArrayValue {
!     my ($this, $array, $index, $value) = @_;
!     
!     # check if a parent state already knows this 
!     # array
!     my $variableHolder = $this -> arrayExists( $array );
! 
!     unless ( defined( $variableHolder ) ) { # array does not exist at all.
          my @newArray = ();
          $newArray[$index] = $value;
          $this -> { m_Arrays } -> { $array } = \@newArray;
+         return 1;
          }
+ 
+     return 0;
+ 
      }
+ 
      
  #/**
***************
*** 242,246 ****
  # array exists.
  # @param the name of the array.
! # @return the largest valid index within the array.
  #*/
  sub getLargestArrayIndex {
--- 300,305 ----
  # array exists.
  # @param the name of the array.
! # @return the largest valid index within the array or undef, if the
! #   array doesn't exist.
  #*/
  sub getLargestArrayIndex {
***************
*** 259,262 ****
--- 318,323 ----
  # @param a string containing the object name.
  # @param a scalar containing the value
+ # @return nonzero if the value could be set, zero if the object
+ #   didn't exist.
  # 
  #*/
***************
*** 271,278 ****
          # Yes another one has it.
          $variableHolder -> setObjectValue( $object, $value );
          }
!     else {  # object is in this state or not defined at all
          $this -> { m_Objects } -> { $object } = $value;
          }
      }
      
--- 332,362 ----
          # Yes another one has it.
          $variableHolder -> setObjectValue( $object, $value );
+         return 1;
          }
!     return 0;
!     }
! 
! #/**
! # Sets an object for the given name.The name
! # first looked up in parent state, if it does exist there
! # then it is set there, else it is set in current state.
! # @param a string containing the object name.
! # @param a scalar containing the value
! # @return nonzero if the object could be created,
! #   zero if the object already exists
! #*/
! sub createObjectValue {
!     my ( $this, $object, $value ) = @_;
!     
!     # check if a parent state already knows this 
!     # object
!     my $variableHolder = $this -> objectExists( $object );
!     
!     unless ( defined( $variableHolder ) ) {  
!         # object is not defined at all
          $this -> { m_Objects } -> { $object } = $value;
+         return 1;
          }
+     return 0;
      }
      

Index: StatementEvaluator.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/StatementEvaluator.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** StatementEvaluator.pm	2 Jun 2002 19:31:23 -0000	1.7
--- StatementEvaluator.pm	9 Jun 2002 12:50:04 -0000	1.8
***************
*** 58,62 ****
      # so some time can be saved by this.
      #
!     if ($aString =~ /[^ \n]/) {
          
          # Reworked evaluation of variables.
--- 58,62 ----
      # so some time can be saved by this.
      #
!     if ($aString =~ /[^\s\n]/) {
          
          # Reworked evaluation of variables.
***************
*** 67,72 ****
          
          # Quite hefty regexp. Does find the innermost pair parentheses which is not quoted.
- #        while ( $aString =~ /^(.*[^\\])\(((\\\(|\\\)|[^\(\)])*[^\\\)])?\)((\\\(|[^\(])*)$/ ) {
-         
          while ( $aString =~ /^(.*[^\\])\(((\\\(|\\\)|[^\(\)])*[^\\\)]?)?\)((\\\(|[^\(])*)$/ ) {
              # Search for the innermost pair of parentheses.
--- 67,70 ----
***************
*** 101,111 ****
                      }
                      }
!                 elsif ($action eq 'eval') { # an eval-statement
                      $result = eval($param);
                      }
!                 elsif ($action eq '@') { #last index of an array
                      $result = $this -> getLargestArrayIndex( $param );
                      }
!                 elsif ($action eq '#') { #length of string
                      $result = $this -> getStringLength( $param );
                      }
--- 99,109 ----
                      }
                      }
!                 elsif ($action eq 'eval' || $action eq '?' ) { # an eval-statement
                      $result = eval($param);
                      }
!                 elsif ($action eq 'alen' || $action eq '@') { #last index of an array
                      $result = $this -> getLargestArrayIndex( $param );
                      }
!                 elsif ($action eq 'slen' || $action eq '#') { #length of string
                      $result = $this -> getStringLength( $param );
                      }
***************
*** 141,145 ****
      my $result = $this -> interpreter() -> getState() ->
              getVariableValue( $variable );
!     # TODO: check for undef
      $result;
      }
--- 139,147 ----
      my $result = $this -> interpreter() -> getState() ->
              getVariableValue( $variable );
!     unless( defined( $result ) ) {
!         $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
!                 $NetScript::Interpreter::FATAL_EVENT,
!                 "A variable named \"$variable\" doesn't exist!" );
!         }
      $result;
      }
***************
*** 155,159 ****
      my $result = $this -> interpreter() -> getState() -> 
              getArrayValue( $array, $index );
!     # TODO: check for undef
      $result;
      }
--- 157,166 ----
      my $result = $this -> interpreter() -> getState() -> 
              getArrayValue( $array, $index );
! 
!     unless( defined( $result ) ) {
!         $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
!                 $NetScript::Interpreter::FATAL_EVENT,
!                 "An array named \"$array\" doesn't exist!" );
!         }
      $result;
      }
***************
*** 168,172 ****
      my $result = $this -> interpreter() -> getState() ->
              getLargestArrayIndex( $array );
!     # TODO: check for undef
      $result;            
      }
--- 175,184 ----
      my $result = $this -> interpreter() -> getState() ->
              getLargestArrayIndex( $array );
! 
!     unless( defined( $result ) ) {
!         $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
!                 $NetScript::Interpreter::FATAL_EVENT,
!                 "An array named \"$array\" doesn't exist!" );
!         }
      $result;            
      }
***************
*** 178,189 ****
  #*/
  sub getMember {
!     my ( $this, $object, $member ) = @_;
      my $object = $this -> interpreter() -> getState() ->
!             getObjectValue( $object );
              
!     # $object is an instance of Class 
!     return undef unless $object ;
      my $memberObject = $object -> member( $member );
!     return undef unless $memberObject;
      $memberObject -> value();
      }
--- 190,210 ----
  #*/
  sub getMember {
!     my ( $this, $objectName, $member ) = @_;
      my $object = $this -> interpreter() -> getState() ->
!             getObjectValue( $objectName );
              
!     # check if object exists
!     unless( defined( $object ) ) {
!         $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
!                 $NetScript::Interpreter::FATAL_EVENT,
!                 "An object named \"$objectName\" doesn't exist!" );
!         }
      my $memberObject = $object -> member( $member );
!     # check if member exists
!     unless( defined( $memberObject ) ) {
!         $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
!                 $NetScript::Interpreter::FATAL_EVENT,
!                 "The object \"$objectName\" has no member named \"$member\"!" );
!         }
      $memberObject -> value();
      }
***************
*** 198,207 ****
  
      if ( $name =~ /(^.*):(.*$)/ ) { # its an array
!         $this -> interpreter() -> getState() -> 
!                 setArrayValue( $1, $2, $value );
          }
      else {
!         $this -> interpreter() -> getState() ->
!                 setVariableValue( $name, $value );
          }
      }
--- 219,262 ----
  
      if ( $name =~ /(^.*):(.*$)/ ) { # its an array
!         unless( $this -> interpreter() -> getState() -> 
!                 createArrayValue( $1, $2, $value ) ) {
!             $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
!                     $NetScript::Interpreter::FATAL_EVENT,
!                     "An array named \"$1\" already exists!" );
!             }
          }
      else {
!         unless( $this -> interpreter() -> getState() -> 
!                 createVariableValue( $name, $value ) ) {
!             $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
!                     $NetScript::Interpreter::FATAL_EVENT,
!                     "A variable named \"$name\" already exists!" );
!             }
!         }
!     }
! 
! #/**
! # Sets the given variable (array)
! # @param string describing the variable name
! # @param string holding the variable value
! #*/
! sub setVariable {
!     my ( $this, $name, $value ) = @_;
! 
!     if ( $name =~ /(^.*):(.*$)/ ) { # its an array
!         unless( $this -> interpreter() -> getState() -> 
!                 setArrayValue( $1, $2, $value ) ) {
!             $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
!                     $NetScript::Interpreter::FATAL_EVENT,
!                     "An array named \"$1\" doesn't exist!" );
!             }
!         }
!     else {
!         unless( $this -> interpreter() -> getState() -> 
!                 setVariableValue( $name, $value ) ) {
!             $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
!                     $NetScript::Interpreter::FATAL_EVENT,
!                     "A variable named \"$name\" doesn't exist!" );
!             }
          }
      }