[NetScript CVS] CVS: netscript2/src/perl/NetScript/Engine DOMWalker.pm,1.8,1.9 StatementEvaluator.pm,1.11,1.12

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

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

Modified Files:
	DOMWalker.pm StatementEvaluator.pm 
Log Message:
* small fixes

Index: DOMWalker.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/DOMWalker.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** DOMWalker.pm	11 Jul 2002 22:03:09 -0000	1.8
--- DOMWalker.pm	18 Sep 2002 13:19:14 -0000	1.9
***************
*** 204,207 ****
--- 204,208 ----
  #   the reference target node; false -else (this flag is only valid if
  #   the given node is an <code>XML::DOM2::Element</code>)
+ # @return the inserted node
  # @public 
  #*/
***************
*** 221,224 ****
--- 222,226 ----
          $this -> setCurrentTarget( $clone ) ;
          }
+     $clone;
      }
  

Index: StatementEvaluator.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/StatementEvaluator.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** StatementEvaluator.pm	7 Aug 2002 20:13:49 -0000	1.11
--- StatementEvaluator.pm	18 Sep 2002 13:19:14 -0000	1.12
***************
*** 37,41 ****
--- 37,43 ----
      my $this = {};
      bless( $this, $class );             # create Object
+     my %functions = ();
      $this -> { m_interpreter } = $interpreter;
+     $this -> { m_registeredFunctions } = \%functions;
      return $this;                       # return Object
      }
***************
*** 99,105 ****
                      $result = $this -> getStringLength( $param );
                      }
                  else {
!                     # XXX: Problem unknown statement
                      }
                  }
              else {
--- 101,115 ----
                      $result = $this -> getStringLength( $param );
                      }
+                 elsif ( $action eq 'xmlenc' ) {
+                     $result = $this -> xmlEncode( $param );
+                     }
                  else {
!                     my $ref = $this -> { m_registeredFunctions } -> { $action };
!                     if ( defined( $ref ) ) {
!                         my ( $object, $sub ) = @{ $ref };
!                         $result = $object -> $sub( $param, $this, $this -> interpreter() );
!                         }
                      }
+                     # XXX: Problem unknown statement
                  }
              else {
***************
*** 185,193 ****
  
      # continue until all is resolved
! warn "toResolve: $toResolve";
      while ( $toResolve =~ /^([^\.]+)\.?(.*)$/ ) {
          my $memberName = $1;
          $toResolve = $2;
! warn "splitted: member=$memberName, toResolve=$toResolve, index=$index";
          # we got a MEMBER in $object, so we now extract its value
          # which must be a CLASS
--- 195,203 ----
  
      # continue until all is resolved
! #warn "toResolve: $toResolve";
      while ( $toResolve =~ /^([^\.]+)\.?(.*)$/ ) {
          my $memberName = $1;
          $toResolve = $2;
! #warn "splitted: member=$memberName, toResolve=$toResolve, index=$index";
          # we got a MEMBER in $object, so we now extract its value
          # which must be a CLASS
***************
*** 203,207 ****
              $memberName = $1;
              $index = $2;
! warn "Is Array: Splitting: MemberName=$memberName, index=$index"
              }
  
--- 213,217 ----
              $memberName = $1;
              $index = $2;
! #warn "Is Array: Splitting: MemberName=$memberName, index=$index"
              }
  
***************
*** 245,251 ****
  sub createVariable {
      my ( $this, $name, $value ) = @_;
- 
      # check if variable name is correct.
!     if ( $name =~/[^a-zA-Z0-9_]/ ) {
          $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                  $NetScript::Interpreter::FATAL_EVENT,
--- 255,260 ----
  sub createVariable {
      my ( $this, $name, $value ) = @_;
      # check if variable name is correct.
!     if ( $name =~/[^a-zA-Z0-9_:!]/ ) {
          $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                  $NetScript::Interpreter::FATAL_EVENT,
***************
*** 256,263 ****
      if ( $name =~ /(^.*):(.*$)/ ) { # its an array
          my $object = $this -> resolveObject( $1, 1); # fetch the array object (quiet!)
!         if ( defined( $object ) ) {
              $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                      $NetScript::Interpreter::FATAL_EVENT,
!                     "A variable named \"$1\" already exists!" );
              return;
              }
--- 265,272 ----
      if ( $name =~ /(^.*):(.*$)/ ) { # its an array
          my $object = $this -> resolveObject( $1, 1); # fetch the array object (quiet!)
!         if ( $object ) {
              $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                      $NetScript::Interpreter::FATAL_EVENT,
!                     "An array named \"$1\" already exists!" );
              return;
              }
***************
*** 265,269 ****
          my $valueMember = NetScript::Engine::Member -> new();
          $valueMember -> setValue( $value );
!         $newArray[$2] = $valueMember; # set value
          my $arrayMember = NetScript::Engine::Member -> new();
          $arrayMember -> setName( $1 );
--- 274,280 ----
          my $valueMember = NetScript::Engine::Member -> new();
          $valueMember -> setValue( $value );
!         if ( $2 ne "!" ) {
!             $newArray[$2] = $valueMember; # set value
!             }
          my $arrayMember = NetScript::Engine::Member -> new();
          $arrayMember -> setName( $1 );
***************
*** 313,316 ****
--- 324,328 ----
  #/**
  # Returns an instance of <code>NetScript.:Interpreter</code>
+ # @private
  #*/ 
  sub interpreter {
***************
*** 319,322 ****
--- 331,397 ----
      }
  
+ #/**
+ # Enables libraries to register their own functions like
+ # "alen" or "eval". The registered function will be called with
+ # the following parameters: 
+ #  <ul>
+ #       <li>the function parameter (the string between the []'s)</li>
+ #       <li>an instance of StatementEvaluator</li>
+ #       <li>an instance of Interpreter</li>
+ #  </ul>
+ # The functions have to be kept short in calculation time. Do not perform
+ # any complex operations within these functions. These functions are required
+ # to return a string.
+ # @param the name of the function to register
+ # @param the object on which to call a sub
+ # @param the name of the sub to call
+ # @public
+ #*/
+ sub registerLibraryFunction {
+     my ( $this, $name, $object, $sub ) = @_;
+ 
+     if ( $name eq "eval" || $name eq "alen" || $name eq "slen" ||
+             $name eq '?' || $name eq '?' || $name eq '#' || $name eq "xmlenc" ||
+             defined( $this -> { m_registeredFunctions } -> { $name } ) ) {
+ 
+         $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
+                 $NetScript::Interpreter::FATAL_EVENT, 
+                 "Library error! A library tried to register the function \"$name\", that is already registered!" );
+         return;        
+         }
+     my @info =  ( $object, $sub );
+     $this -> { m_registeredFunctions } -> { $name } = \@info;
+     }
+ 
+ #/**
+ # Deregister Library functions.
+ # @param the name of the function to deregister.
+ # @public
+ #*/
+ sub deregisterLibraryFunction {
+     my ( $this, $name ) = @_;
+     if ( $name eq "eval" || $name eq "alen" || $name eq "slen" ||
+             $name eq '?' || $name eq '?' || $name eq '#' || $name eq "xmlenc" ) {
+         $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
+                 $NetScript::Interpreter::FATAL_EVENT, 
+                 "Library error! A library tried to deregister the function \"$name\", which is not permitted!" );
+         return;        
+         }
+     delete $this -> { m_registeredFunctions } -> { $name };
+     
+     }
+ 
+ #/**
+ # XML-Encodes the given String.
+ #*/
+ sub xmlEncode {
+     my ( $this, $toEncode ) = @_;
+     $toEncode =~ s/&/&amp;/g;
+     $toEncode =~ s/</&lt;/g;
+     $toEncode =~ s/>/&gt;/g;
+     $toEncode =~ s/"/&quot;/g;
+     $toEncode =~ s/'/&apos;/g;
+     return $toEncode;
+     }
  
  1; # make "require" happy