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

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

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

Modified Files:
	ControlStructuresLibrary.pm DebugLibrary.pm FormsLibrary.pm 
	Library.pm 
Log Message:
* added library include facility
* moved Wrappers to Engine
* added emergency error page (if error page is missing)
* changed configfilereader to be more generic
* some performance improvements
* overall bugfixing

Index: ControlStructuresLibrary.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/ControlStructuresLibrary.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** ControlStructuresLibrary.pm	29 May 2002 20:27:39 -0000	1.2
--- ControlStructuresLibrary.pm	2 Jun 2002 19:31:23 -0000	1.3
***************
*** 34,37 ****
--- 34,51 ----
  #       
  # </pre>
+ # 
+ # Also this library provides the library loading mechanism of NetScript.
+ # You can load a library by using a processing instruction:
+ # <pre>
+ #       &lt;netscript use LIBNAME&gt;
+ # </pre>
+ # The library must be named &quot;LIBNAMELibrary.pm&quot; and must be located
+ # somewhere below the NetScript/Libraries-directory. The library must be a 
+ # subclass of NetScript::Libraries::Library. As an example there is an example-
+ # library in the docs/netscript/src -folder, which you can use for
+ # creating your own libraries. To test the example copy it somewhere below
+ # the NetScript/Libraries-directory. You should create a subdir, to place
+ # third-party-libraries in another place as the base libraries, 
+ # however this is just a recommendation, it is not needed.
  #*/
  package NetScript::Libraries::ControlStructuresLibrary;
***************
*** 74,80 ****
--- 88,101 ----
              $NetScript::Engine::DOMWalker::ELEMENT_END_EVENT,
              "elementFinished", $this );
+ 
+     my $eventListener3 = NetScript::Engine::EventListener -> new();
+     $eventListener3 -> init(
+             $NetScript::Engine::DOMWalker::PI_EVENT,
+             "processingInstruction", $this );
+ 
      my $eventRelay = $this -> interpreter() -> getEventRelay();
      $eventRelay -> addEventListener( $eventListener1 );
      $eventRelay -> addEventListener( $eventListener2 );
+     $eventRelay -> addEventListener( $eventListener3 );
      }
  
***************
*** 250,253 ****
--- 271,281 ----
          });
  
+     $from = $this -> interpreter() -> getStatementEvaluator() ->
+             evaluateStatement( $from );
+     $to = $this -> interpreter() -> getStatementEvaluator() ->
+             evaluateStatement( $to );
+     $var = $this -> interpreter() -> getStatementEvaluator() ->
+             evaluateStatement( $var );
+ 
      my $value = $this -> { m_forLoops } -> {  $node };
  
***************
*** 302,305 ****
--- 330,340 ----
          });
  
+     $from = $this -> interpreter() -> getStatementEvaluator() ->
+             evaluateStatement( $from );
+     $to = $this -> interpreter() -> getStatementEvaluator() ->
+             evaluateStatement( $to );
+     $var = $this -> interpreter() -> getStatementEvaluator() ->
+             evaluateStatement( $var );
+ 
      my $value = $this -> interpreter() -> getState() ->
          getVariableValue( $var );
***************
*** 352,355 ****
--- 387,411 ----
          }
      }
+ 
+ #/**
+ # Called when a processing instruction occurs.
+ # @callback
+ #*/
+ sub processingInstruction {
+     my ( $this, $event ) = @_;
+     my $domWalker = $event -> eventUnknown();
+     my $node = $domWalker -> currentSource();
+     
+     if ( $node -> target() eq "netscript" ) {
+         my $data = $node -> data();
+         if ( $data =~ /\s*use\s*([^\s]*)/) { # check for "use LIBNAME"
+             $this -> interpreter -> getLibLoader() -> loadLibrary( $1 );
+             $domWalker -> stepSourceIn();
+             return 0; # consume event
+             }
+         }
+     return 1; # do not consume event
+     }
+ 
  
  

Index: DebugLibrary.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/DebugLibrary.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** DebugLibrary.pm	15 May 2002 18:22:18 -0000	1.3
--- DebugLibrary.pm	2 Jun 2002 19:31:23 -0000	1.4
***************
*** 13,16 ****
--- 13,22 ----
  # The debug library catches debug-events and appends all debug
  # message to the end of the document into a comment node.
+ # The following events can be sent to this library:
+ # <ul>
+ # <li><code>DEBUG_LIBRARY_DEBUG_EVENT</code>-will cause a debug message
+ #       to be appended to the result document. The event message is
+ #       treated as the debug message.</li>
+ # </ul>
  #*/
  package NetScript::Libraries::DebugLibrary;
***************
*** 18,23 ****
  
  
  
! our $DEBUG_EVENT = "DEBUG_LIBRARY_DEBUG_EVENT";
  
  use NetScript::Engine::EventListener;
--- 24,30 ----
  
  
+ use vars qw( $DEBUG_EVENT );
  
! $DEBUG_EVENT = "DEBUG_LIBRARY_DEBUG_EVENT";
  
  use NetScript::Engine::EventListener;
***************
*** 34,38 ****
      my $class = ref($proto) || $proto;
      my $this = $class -> SUPER::new();
!     $this -> { m_debug } = "\nDebug Messages:\n-----------------\n";
      $this;
      }
--- 41,45 ----
      my $class = ref($proto) || $proto;
      my $this = $class -> SUPER::new();
!     $this -> { m_debug } = "";
      $this;
      }
***************
*** 65,74 ****
  sub documentFinished {
      my ( $this, $event ) = @_;
!     my $domWalker = $event -> eventUnknown();
!     my $document = $domWalker -> sourceDocument();
!     my $comment = $document -> createComment( { 
!             data => $this -> debugMessage() 
!             } );
!     $domWalker -> insertIntoTarget( $comment );
      1; #do not consume event
      }
--- 72,83 ----
  sub documentFinished {
      my ( $this, $event ) = @_;
!     if ( $this -> debugMessage() ne "" ) {
!         my $domWalker = $event -> eventUnknown();
!         my $document = $domWalker -> sourceDocument();
!         my $comment = $document -> createComment( { 
!                 data => "\nDebug Messages:\n-----------------\n".$this -> debugMessage() 
!                 } );
!         $domWalker -> insertIntoTarget( $comment );
!         }
      1; #do not consume event
      }

Index: FormsLibrary.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/FormsLibrary.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** FormsLibrary.pm	29 May 2002 20:27:39 -0000	1.1
--- FormsLibrary.pm	2 Jun 2002 19:31:23 -0000	1.2
***************
*** 27,32 ****
  # Use it like this:
  # <pre>
! #   &lt;ns:invoke var="C" func="setCookie" prm1="&lt;cookie name&gt;" 
! #        prm2="&lt;cookie value&gt;" prm3="&lt;expires&gt;"/&gt;
  # </pre> 
  #*/
--- 27,32 ----
  # Use it like this:
  # <pre>
! #   &lt;ns:cookie name="<cookie name>" val="<cookie value>" 
! #       expires="<expire date>"/&gt;
  # </pre> 
  #*/
***************
*** 41,45 ****
  use NetScript::Interpreter;
  use NetScript::Engine::DOMWalker;
! use NetScript::Util::ClassWrapper;
  
  #/**
--- 41,45 ----
  use NetScript::Interpreter;
  use NetScript::Engine::DOMWalker;
! use NetScript::Engine::ClassWrapper;
  
  #/**
***************
*** 58,65 ****
      my ($this, $interpreter) = @_;
      $this -> SUPER::init( $interpreter );
!     my $paramWrapper = NetScript::Util::ClassWrapper -> new( $this );
      $paramWrapper -> setMember( ".*", undef, "getParameter" );
  
!     my $cookieWrapper = NetScript::Util::ClassWrapper -> new( $this );
      $cookieWrapper -> setMember( ".*", undef, "getCookie" );
  
--- 58,65 ----
      my ($this, $interpreter) = @_;
      $this -> SUPER::init( $interpreter );
!     my $paramWrapper = NetScript::Engine::ClassWrapper -> new( $this );
      $paramWrapper -> setMember( ".*", undef, "getParameter" );
  
!     my $cookieWrapper = NetScript::Engine::ClassWrapper -> new( $this );
      $cookieWrapper -> setMember( ".*", undef, "getCookie" );
  
***************
*** 68,71 ****
--- 68,129 ----
      # register the C-object
      $this -> interpreter() -> getState() -> setObjectValue( "C", $cookieWrapper );
+     
+     # register event listeners for the cookie-tag
+     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 "cookie") {
+             $this -> setCookie( $node, $domWalker );
+             0; # consume event
+             }
+         else {
+             1; # do not consume event
+             }
+         }
+     else {
+         1; # do not consume event
+         }
+     }
+ 
+ #/**
+ # Called upon element finish.
+ # @callback
+ #*/
+ 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 "cookie") {
+             0; # consume event 
+             }
+         else {
+             1; # do not consume
+             }
+         }
+     else {
+         1; # do not consume event
+         }
      }
  
***************
*** 80,84 ****
      my ( $this, $name ) = @_;
      my $cgi = $this -> interpreter() -> getCGI();
-     $this -> debug( "Getting parameter: $name ... " );
      my $pName = $name;
      my $pIndex = 0;
--- 138,141 ----
***************
*** 104,107 ****
--- 161,188 ----
  
  
+ #/**
+ # Sets the given cookie.
+ # @param the node representing the cookie-tag.
+ # @param an instance of NetScript::Engine::DOMWalker
+ # @callback
+ #*/
+ sub setCookie {
+     my ( $this, $node, $walker ) = @_;
+     my $name = $node -> getAttribute( {
+         name => "name" } );
+     my $value = $node -> getAttribute( {
+         name => "val" } );
+     my $expires = $node -> getAttribute( {
+         name => "expires" } );
+         
+     $name = $this -> interpreter() -> getStatementEvaluator() ->
+             evaluateStatement( $name );
+     $value = $this -> interpreter() -> getStatementEvaluator() ->
+             evaluateStatement( $value );
+     $expires = $this -> interpreter() -> getStatementEvaluator() ->
+             evaluateStatement( $expires );
+     
+     $this -> interpreter() -> setCookie( $name, $value, $expires );
+     }
  
  

Index: Library.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/Library.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Library.pm	15 May 2002 18:22:18 -0000	1.3
--- Library.pm	2 Jun 2002 19:31:23 -0000	1.4
***************
*** 46,50 ****
  # @public
  # @abstract
! # @note subclasses should call this sub if they override it
  #*/
  sub init {
--- 46,50 ----
  # @public
  # @abstract
! # @note subclasses should call this sub if they override it!
  #*/
  sub init {