net-script-commits

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

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

Modified Files:
	ControlStructuresLibrary.pm 
Added Files:
	FormsLibrary.pm VariablesLibrary.pm 
Log Message:
* added library for parameter and cookie retrieval

--- NEW FILE: FormsLibrary.pm ---
#--------------------------------------------------------
# $Id: FormsLibrary.pm,v 1.1 2002/05/29 20:27:39 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;

#/**
# This library adds support for form parameter evaluation
# and cookies. Two objects named P and C are added to the global
# state. These objects have members with the same name as 
# all available cookies and form parameters. Use them as any other
# object member. 
# <pre>
#       The form parameter NAME is $(P.NAME).
#       The cookie UID has the value $(C.UID).
# </pre>
# It is possible but not recommended to create own objects named
# P and C, however this will overwrite the ones created by this
# library (and you will stand there without any parameters and cookies
# so this is definitely NOT recommended).
# <p>
# Also this library provides a function for setting a cookie.
# 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> 
#*/
package NetScript::Libraries::FormsLibrary;
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;
use NetScript::Util::ClassWrapper;

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


sub init {
    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" );

    # register the P-object
    $this -> interpreter() -> getState() -> setObjectValue( "P", $paramWrapper );
    # register the C-object
    $this -> interpreter() -> getState() -> setObjectValue( "C", $cookieWrapper );
    }


#/**
# Returns the parameter with the given name.
# @param the name of the parameter to retrieve
# @return the value of the parameter.
# @callback
#*/
sub getParameter {
    my ( $this, $name ) = @_;
    my $cgi = $this -> interpreter() -> getCGI();
    $this -> debug( "Getting parameter: $name ... " );
    my $pName = $name;
    my $pIndex = 0;
    if ( $name =~ /(^.*):(.*)$/ ) {
        $pName = $1;
        $pIndex = $2;
        }
    my @values = $cgi -> param( $pName );
    $values[$pIndex];
    }

#/**
# Returns the value of a cookie with the given name
# @param the name of the cookie
# @return the value of the cookie
# @callback
#*/
sub getCookie {
    my ( $this, $name ) = @_;
    my $cgi = $this -> interpreter() -> getCGI();
    $cgi -> cookie( $name );
    }




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,
            "[Forms]" 
            );
    }
1; #make require happy


--- NEW FILE: VariablesLibrary.pm ---
#--------------------------------------------------------
# $Id: VariablesLibrary.pm,v 1.1 2002/05/29 20:27:39 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;

#/**
# This library adds support for variable creation.
# Usage in your NetScripts is as follows.
# <pre>
# 
#   &lt;ns:var var="[variable name]" value="[value]"/&gt;
# </pre>
#*/
package NetScript::Libraries::VariablesLibrary;
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();
    $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 "var") {
            $this -> varStart( $domWalker, $node );
            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 "var") {
            0; # consume event 
            }
        else {
            1; # do not consume
            }
        }
    else {
        1; # do not consume event
        }
    }


#/**
# Called, when a variable starts.
# @callback
# @param an instance of <code>NetScript::Engine::DOMWalker</code>
# @param an instance of <code>XML::DOM2::Element</code>
#*/
sub varStart {
    my ( $this, $domWalker, $node ) = @_;
    my $name = $node -> getAttribute( {
        name => "var"
        });
    # replace variables
    my $se = $this -> interpreter() -> getStatementEvaluator();
    $name = $se -> evaluateStatement( $name );
    my $value = $node -> getAttribute( {
        name => "val"
        });
    $value = $se -> evaluateStatement( $value );
    $this -> interpreter() -> getStatementEvaluator() ->
        createVariable( $name, $value );
    $domWalker -> stepSourceIn();
    }


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,
            "[Variables]" 
            );
    }
1; #make require happy


Index: ControlStructuresLibrary.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/ControlStructuresLibrary.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** ControlStructuresLibrary.pm	15 May 2002 18:22:18 -0000	1.1
--- ControlStructuresLibrary.pm	29 May 2002 20:27:39 -0000	1.2
***************
*** 141,148 ****
--- 141,151 ----
      unless ( $this -> checkNodeTest( $node ) ) {
          # test did not succeed, so we jump to the next sibling if any        
+         # dummy state, will be killed in the next step
+         $this -> interpreter() -> newState(); 
          $domWalker -> stepSourceNext();
          }
      else {
          # condition is true, proceed as usual
+         $this -> interpreter() -> newState();
          $domWalker -> stepSourceIn();
          }
***************
*** 174,180 ****
--- 177,186 ----
              # test did not succeed, so we proceed with the else case
              $domWalker -> stepSourceIn();
+             $this -> interpreter() -> newState();
              }
          else {
              # condition is true, proceed as usual
+             # dummy state, will be killed in the next step
+             $this -> interpreter() -> newState(); 
              $domWalker -> stepSourceNext();
              }
***************
*** 203,206 ****
--- 209,213 ----
          # condition is true, proceed as usual
          $domWalker -> stepSourceIn();
+         $this -> interpreter() -> newState();
          }
      }
***************
*** 214,217 ****
--- 221,225 ----
  sub whileEnd {
      my ( $this, $domWalker, $node ) = @_;
+     $this -> interpreter() -> dropState();
      if ( $this -> checkNodeTest( $node ) ) {
          $domWalker -> sourceAgain();        
***************
*** 296,300 ****
      my $value = $this -> interpreter() -> getState() ->
          getVariableValue( $var );
!         
      $this -> interpreter() -> dropState();
      if ( ( $from <= $to &&  $value <= $to ) ||
--- 304,308 ----
      my $value = $this -> interpreter() -> getState() ->
          getVariableValue( $var );
! 
      $this -> interpreter() -> dropState();
      if ( ( $from <= $to &&  $value <= $to ) ||
***************
*** 311,314 ****
--- 319,323 ----
  #/**
  # Called upon element finish.
+ # @callback
  #*/
  sub elementFinished {
***************
*** 318,326 ****
      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 
              }
--- 327,337 ----
      if ( $node -> namespaceURI() eq $NetScript::Interpreter::NAMESPACE_URI ) {
          if ($node -> localName() eq "if") {
!             # kill state
!             $this -> interpreter() -> dropState();
              0; # consume event 
              }
          elsif ($node -> localName() eq "else") {
!             # kill state
!             $this -> interpreter() -> dropState();
              0; # consume event 
              }