From: Jan T. <de...@us...> - 2002-06-09 12:49:10
|
Update of /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries In directory usw-pr-cvs1:/tmp/cvs-serv25269 Modified Files: ControlStructuresLibrary.pm DebugLibrary.pm FormsLibrary.pm VariablesLibrary.pm Log Message: * re-implemented for-loop * changed semantics of the var-tag Index: ControlStructuresLibrary.pm =================================================================== RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/ControlStructuresLibrary.pm,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** ControlStructuresLibrary.pm 2 Jun 2002 19:31:23 -0000 1.3 --- ControlStructuresLibrary.pm 9 Jun 2002 12:49:07 -0000 1.4 *************** *** 69,73 **** --- 69,75 ---- my $this = $class -> SUPER::new(); my %forLoops = (); + my %forLoopsVarNames = (); $this -> { m_forLoops } = \%forLoops; + $this -> { m_forLoopsVarNames } = \%forLoopsVarNames; $this; } *************** *** 108,125 **** 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 --- 110,127 ---- my $domWalker = $event -> eventUnknown(); my $node = $domWalker -> currentSource(); ! if ( $node -> getNamespaceURI() eq $NetScript::Interpreter::NAMESPACE_URI ) { ! if ($node -> getLocalName() eq "if") { $this -> ifStart( $domWalker, $node ); 0; # consume event } ! elsif( $node -> getLocalName() eq "else" ) { $this -> elseStart( $domWalker, $node ); 0; # consume event } ! elsif ($node -> getLocalName() eq "while" ) { $this -> whileStart( $domWalker, $node ); 0; # consume event } ! elsif ($node -> getLocalName() eq "for" ) { $this -> forStart( $domWalker, $node ); 0; # consume event *************** *** 142,148 **** sub checkNodeTest { my ($this, $node) = @_; ! my $test = $node -> getAttribute( { ! name => "test" ! }); # replace variables my $se = $this -> interpreter() -> getStatementEvaluator(); --- 144,148 ---- sub checkNodeTest { my ($this, $node) = @_; ! my $test = $node -> getAttribute("test"); # replace variables my $se = $this -> interpreter() -> getStatementEvaluator(); *************** *** 182,196 **** 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 --- 182,196 ---- my ( $this, $domWalker, $node ) = @_; # find the belonging IF-Node ! my $ifNode = $node -> getPreviousSibling(); # skip text nodes ! while ( $ifNode && $ifNode -> getNodeType() == $XML::DOM2::Node::TEXT_NODE ) { ! $ifNode = $ifNode -> getPreviousSibling(); } if ( $ifNode && ! $ifNode -> getNamespaceURI() eq $NetScript::Interpreter::NAMESPACE_URI && ! $ifNode -> getLocalName() eq "if") { # check condition *************** *** 208,212 **** } else { ! # FIXME: DO not use DIE die "Else without IF" ; } --- 208,212 ---- } else { ! # FIXME: DO NOT use DIE die "Else without IF" ; } *************** *** 260,306 **** ! my $from = $node -> getAttribute({ ! name => "from" ! }); ! my $to = $node -> getAttribute({ ! name => "to" ! }); ! my $var = $node -> getAttribute({ ! name => "var" ! }); ! $from = $this -> interpreter() -> getStatementEvaluator() -> ! evaluateStatement( $from ); ! $to = $this -> interpreter() -> getStatementEvaluator() -> ! evaluateStatement( $to ); ! $var = $this -> interpreter() -> getStatementEvaluator() -> ! evaluateStatement( $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(); } --- 260,338 ---- ! my $from = $node -> getAttribute( "from" ); ! my $to = $node -> getAttribute( "to" ); ! my $var = $node -> getAttribute( "var" ); ! my $name = $node -> getAttribute( "name" ); ! my $step = $node -> getAttribute( "step" ); ! my $varOrig = $var; ! my $nameOrig = $name; ! my $se = $this -> interpreter() -> getStatementEvaluator(); ! $from = $se -> evaluateStatement( $from ); ! $to = $se -> evaluateStatement( $to ); ! $var = $se -> evaluateStatement( $var ); ! $step = $se -> evaluateStatement( $step ); ! $name = $se -> evaluateStatement( $name ); ! ! unless ( $step =~ /^-?[0-9]+$/ ) { # if step is not given or not numeric it is 1 ! $step = 1; ! } ! ! my $theVar; ! my $createVar = 0; + if ( $var eq "" && $name ne "" ) { + $theVar = $name; + $createVar = 1; + $this -> { m_forLoopsVarNames } -> { $node } = $nameOrig; + } + elsif( $var ne "" && $name eq "" ) { + $theVar = $var; + $this -> { m_forLoopsVarNames } -> { $node } = $varOrig; + } + else { + $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( + $NetScript::Interpreter::FATAL_EVENT, + "None or both of the \"name\" or \"var\" attributes in for-loop are specified.\n". + "You must specify one of these." ); + } + my $value = $this -> { m_forLoops } -> { $node }; ! unless ( defined( $value ) ) { # variable is yet unknown so we initialize it $value = $from; } else { ! $value += $step; } # create new state $this -> interpreter() -> newState(); ! if ( $createVar ) { ! # create variable ! unless( $this -> interpreter() -> getState() -> createVariableValue( ! $theVar, $value ) ) { ! $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( ! $NetScript::Interpreter::FATAL_EVENT, ! "A variable named $theVar already exists. Use var=\"$theVar\" instead of name=\"$theVar\"." ); ! } ! } ! else { ! # set variable ! unless( $this -> interpreter() -> getState() -> setVariableValue( ! $theVar, $value ) ) { ! $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent( ! $NetScript::Interpreter::FATAL_EVENT, ! "A variable named $theVar doesn't exist. Use name=\"$theVar\" instead of var=\"$theVar\"." ); ! } ! } $this -> { m_forLoops } -> { $node } = $value; ! if ( ( $from < $to && ( $value > $to || $value < $from ) ) || ! ( $from > $to && ( $value < $to || $value > $from ) ) || ! ( $from == $to && $value != $from ) ) { # check if loop should be executed # no it should not, skip node + delete $this -> { m_forLoops } -> { $node }; + $this -> interpreter() -> dropState(); $domWalker -> stepSourceNext(); } *************** *** 319,353 **** sub forEnd { my ($this, $domWalker, $node) = @_; ! my $from = $node -> getAttribute({ ! name => "from" ! }); ! my $to = $node -> getAttribute({ ! name => "to" ! }); ! ! my $var = $node -> getAttribute({ ! name => "var" ! }); ! ! $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 ); ! $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 }; - } } --- 351,367 ---- sub forEnd { my ($this, $domWalker, $node) = @_; ! if ( defined( $this -> { m_forLoops } -> { $node } ) ) { ! # if the variable value was changed in the loop we have to ! # reflect this in our internal setting. ! my $varName = $this -> { m_forLoopsVarNames } -> { $node }; ! $varName = $this -> interpreter() -> getStatementEvaluator() -> ! evaluateStatement( $varName ); ! my $varValue = $this -> interpreter() -> getState() -> ! getVariableValue( $varName ); ! $this -> { m_forLoops } -> { $node } = $varValue; ! $this -> interpreter() -> dropState(); $domWalker -> sourceAgain(); } } *************** *** 360,379 **** my $domWalker = $event -> eventUnknown(); my $node = $domWalker -> currentSource(); ! 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 } ! elsif ($node -> localName() eq "while" ) { $this -> whileEnd( $domWalker, $node ); 0; # consume event } ! elsif ($node -> localName() eq "for" ) { $this -> forEnd( $domWalker, $node ); 0; # consume event --- 374,393 ---- my $domWalker = $event -> eventUnknown(); my $node = $domWalker -> currentSource(); ! if ( $node -> getNamespaceURI() eq $NetScript::Interpreter::NAMESPACE_URI ) { ! if ($node -> getLocalName() eq "if") { # kill state $this -> interpreter() -> dropState(); 0; # consume event } ! elsif ($node -> getLocalName() eq "else") { # kill state $this -> interpreter() -> dropState(); 0; # consume event } ! elsif ($node -> getLocalName() eq "while" ) { $this -> whileEnd( $domWalker, $node ); 0; # consume event } ! elsif ($node -> getLocalName() eq "for" ) { $this -> forEnd( $domWalker, $node ); 0; # consume event *************** *** 397,402 **** 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 ); --- 411,416 ---- my $node = $domWalker -> currentSource(); ! if ( $node -> getTarget() eq "netscript" ) { ! my $data = $node -> getData(); if ( $data =~ /\s*use\s*([^\s]*)/) { # check for "use LIBNAME" $this -> interpreter -> getLibLoader() -> loadLibrary( $1 ); Index: DebugLibrary.pm =================================================================== RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/DebugLibrary.pm,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** DebugLibrary.pm 2 Jun 2002 19:31:23 -0000 1.4 --- DebugLibrary.pm 9 Jun 2002 12:49:07 -0000 1.5 *************** *** 75,81 **** my $domWalker = $event -> eventUnknown(); my $document = $domWalker -> sourceDocument(); ! my $comment = $document -> createComment( { ! data => "\nDebug Messages:\n-----------------\n".$this -> debugMessage() ! } ); $domWalker -> insertIntoTarget( $comment ); } --- 75,80 ---- my $domWalker = $event -> eventUnknown(); my $document = $domWalker -> sourceDocument(); ! my $comment = $document -> createComment( ! "\nDebug Messages:\n-----------------\n".$this -> debugMessage() ); $domWalker -> insertIntoTarget( $comment ); } Index: FormsLibrary.pm =================================================================== RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/FormsLibrary.pm,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** FormsLibrary.pm 2 Jun 2002 19:31:23 -0000 1.2 --- FormsLibrary.pm 9 Jun 2002 12:49:07 -0000 1.3 *************** *** 93,98 **** 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 --- 93,98 ---- my $domWalker = $event -> eventUnknown(); my $node = $domWalker -> currentSource(); ! if ( $node -> getNamespaceURI() eq $NetScript::Interpreter::NAMESPACE_URI ) { ! if ($node -> getLocalName() eq "cookie") { $this -> setCookie( $node, $domWalker ); 0; # consume event *************** *** 115,120 **** my $domWalker = $event -> eventUnknown(); my $node = $domWalker -> currentSource(); ! if ( $node -> namespaceURI() eq $NetScript::Interpreter::NAMESPACE_URI ) { ! if ($node -> localName() eq "cookie") { 0; # consume event } --- 115,120 ---- my $domWalker = $event -> eventUnknown(); my $node = $domWalker -> currentSource(); ! if ( $node -> getNamespaceURI() eq $NetScript::Interpreter::NAMESPACE_URI ) { ! if ($node -> getLocalName() eq "cookie") { 0; # consume event } *************** *** 169,185 **** 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 ); --- 169,180 ---- sub setCookie { my ( $this, $node, $walker ) = @_; ! my $name = $node -> getAttribute( "name" ); ! my $value = $node -> getAttribute( "val" ); ! my $expires = $node -> getAttribute( "expires"); ! my $se = $this -> interpreter() -> getStatementEvaluator(); ! $name = $se -> evaluateStatement( $name ); ! $value = $se -> evaluateStatement( $value ); ! $expires = $se -> evaluateStatement( $expires ); $this -> interpreter() -> setCookie( $name, $value, $expires ); Index: VariablesLibrary.pm =================================================================== RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/VariablesLibrary.pm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** VariablesLibrary.pm 29 May 2002 20:27:39 -0000 1.1 --- VariablesLibrary.pm 9 Jun 2002 12:49:07 -0000 1.2 *************** *** 68,73 **** 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 --- 68,73 ---- my $domWalker = $event -> eventUnknown(); my $node = $domWalker -> currentSource(); ! if ( $node -> getNamespaceURI() eq $NetScript::Interpreter::NAMESPACE_URI ) { ! if ($node -> getLocalName() eq "var") { $this -> varStart( $domWalker, $node ); 0; # consume event *************** *** 90,95 **** my $domWalker = $event -> eventUnknown(); my $node = $domWalker -> currentSource(); ! if ( $node -> namespaceURI() eq $NetScript::Interpreter::NAMESPACE_URI ) { ! if ($node -> localName() eq "var") { 0; # consume event } --- 90,95 ---- my $domWalker = $event -> eventUnknown(); my $node = $domWalker -> currentSource(); ! if ( $node -> getNamespaceURI() eq $NetScript::Interpreter::NAMESPACE_URI ) { ! if ($node -> getLocalName() eq "var") { 0; # consume event } *************** *** 112,127 **** 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(); } --- 112,130 ---- sub varStart { my ( $this, $domWalker, $node ) = @_; ! my $var = $node -> getAttribute( "var" ); ! my $name = $node -> getAttribute( "name" ); # replace variables my $se = $this -> interpreter() -> getStatementEvaluator(); $name = $se -> evaluateStatement( $name ); ! $var = $se -> evaluateStatement( $var ); ! my $value = $node -> getAttribute( "val"); $value = $se -> evaluateStatement( $value ); ! ! if ( $name ne "" && $var eq "" ) { ! $se -> createVariable( $name, $value ); ! } ! elsif( $name eq "" && $var ne "" ) { ! $se -> setVariable( $var, $value ); ! } $domWalker -> stepSourceIn(); } |