net-script-commits — All CVS commits will be posted to this list.

[NetScript CVS] CVS: netscript2/src/perl/NetScript/Libraries ControlStructuresLibrary.pm,1.9,1.10 FormsLibrary.pm,1.6,1.7 StringsLibrary.pm,1.1,1.2

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

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

Modified Files:
	ControlStructuresLibrary.pm FormsLibrary.pm StringsLibrary.pm 
Log Message:
* added documentation

Index: ControlStructuresLibrary.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/ControlStructuresLibrary.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** ControlStructuresLibrary.pm	14 Aug 2002 22:23:35 -0000	1.9
--- ControlStructuresLibrary.pm	24 Sep 2002 22:22:03 -0000	1.10
***************
*** 473,476 ****
--- 473,484 ----
              $fileURL = $this -> checkURL( $fileURL );
  
+             if ( $fileURL =~ /^http:/ || $fileURL =~ /^ftp:/ ) {
+                 unless ( $this -> interpreter() -> getConfig() -> getSetting( "ALLOW_REMOTE_SCRIPTS" ) =~ /yes/ ) {
+                     $this -> getEventRelay() -> createAndRaiseEvent( 
+                             $NetScript::Interpreter::FATAL_EVENT, 
+                             "Cannot import $fileURL,\n local security settings forbid to import scripts from foreign hosts!" );
+                     }
+                 }
+             
              my $fileData = $this -> interpreter() -> getFileRetriever() ->
                      retrieveFile( $fileURL );

Index: FormsLibrary.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/FormsLibrary.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** FormsLibrary.pm	18 Sep 2002 13:20:09 -0000	1.6
--- FormsLibrary.pm	24 Sep 2002 22:22:03 -0000	1.7
***************
*** 27,33 ****
  # Use it like this:
  # <pre>
! #   &lt;ns:cookie name="<cookie name>" val="<cookie value>" 
! #       expires="<expire date>"/&gt;
  # </pre> 
  #*/
  package NetScript::Libraries::FormsLibrary;
--- 27,57 ----
  # Use it like this:
  # <pre>
! #   &lt;ns:cookie name=&quot;&lt;cookie name&gt;&quot; val=&quot;&lt;cookie value&gt;&quot; expires=&quot;&lt;expire date&gt;&quot;/&gt;
  # </pre> 
+ #
+ # You can upload files using the upload-function.
+ # <pre>
+ #   &lt;ns:upload parameter=&quot;&lt;parameter&gt;&quot; directory=&quot;&lt;directory&gt;&quot; 
+ #       [filename=&quot;&lt;filename&gt;&quot;] [limit=&quot;&lt;limit&gt;&quot;] 
+ #       [bytes=&quot;&lt;bytes&gt;&quot;] [file=&quot;&lt;file&gt;&quot;] 
+ #       [mode=&quot;&lt;DELETE_ON_FAIL|KEEP_ON_FAIL&gt;&quot;] [overwrite=&quot;&lt;yes|no&gt;&quot;]/&gt;
+ # </pre>
+ # Uploads the file which has been sent with the parameter &lt;parameter&gt; to
+ # the specified &lt;directory&gt; on the server. You can rename the filename 
+ # on the server by specifying the new filename in &lt;filename&gt;. You can 
+ # set a maximum filesize in bytes with &lt;limit&gt;. You can specify a variable
+ # name in &lt;bytes&gt;. This variable will receive the number of uploaded bytes.
+ # You can specify a variable name in &lt;file&gt;, this will receive the filename on
+ # the server.You can specify if the file on the server should be deleted if
+ # it exceeds the maximum limit (DELETE_ON_FAIL), or if it should be kept.
+ # Default is KEEP_ON_FAIL. You can also specify if the file should be overwritten
+ # if it already exists. The bytes-variable returns:
+ #   <ul>
+ #       <li>-3 - if the parameter contained no file</li>
+ #       <li>-2 - if the file exists on the server and overwrite is not "yes"</li>
+ #       <li>-1 - if any other error occured</li>
+ #   </ul>
+ #       
+ #       
  #*/
  package NetScript::Libraries::FormsLibrary;
***************
*** 190,208 ****
  #* bytes and the filename on the server into file. Number of written bytes is
  #* -1 if an error occured.
! #
! #* Attribute: parameter - name of the parameter, which contains the file
! #* Attribute: directory - location on the server where the file should be copied to
! #* Attribute: filename - optional, the name of file as it should be stored on the server
! #* Attribute: limit - optional, the maximum number of 1k-blocks that should be uploaded
! #* Attribute: bytes- optional, the name of the variable, where the number of read bytes is stored into
! #* Attribute: file - optional, the name of the variable, where the filename on the server should be stored into.
! #* Attribute: mode - optional, one of the following modes:
! #*           DELETE_ON_FAIL - default, if file exceeds the set limit, file is deleted on the server.
! #*           KEEP_ON_FAIL - file is kept, even if it was cut down to the set limit
! #* Attribute: overwrite - optional, set to yes if existing files should be overwritten, set to no
! #*                        if existing files should not be overwritten. If omitted, existing files will
! #*                        NOT be overwritten. If file exists and overwrite is set to no, then 
! #*                        the value in bytes will be set to -2 and the function will return. 
! #*   
  sub doUpload {
      my ( $this, $node, $domWalker ) = @_;
--- 214,218 ----
  #* bytes and the filename on the server into file. Number of written bytes is
  #* -1 if an error occured.
! #*/
  sub doUpload {
      my ( $this, $node, $domWalker ) = @_;

Index: StringsLibrary.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/StringsLibrary.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** StringsLibrary.pm	14 Aug 2002 22:23:35 -0000	1.1
--- StringsLibrary.pm	24 Sep 2002 22:22:03 -0000	1.2
***************
*** 20,26 ****
  # </pre>
  # <pre>
! #       &lt;ns:split string=&quot;{any string}&quot; delim=&quot;{a delimiter regexp}&quot;
  #               var|name=&quot;var1 [var2 var3 ...]&quot;/&gt;
! # <pre>
  # Splits the given string using the given delimiter and puts the
  # substrings into the given variables. If there is only one variable name
--- 20,26 ----
  # </pre>
  # <pre>
! #       &lt;str:split string=&quot;{any string}&quot; delim=&quot;{a delimiter regexp}&quot;
  #               var|name=&quot;var1 [var2 var3 ...]&quot;/&gt;
! # </pre>
  # Splits the given string using the given delimiter and puts the
  # substrings into the given variables. If there is only one variable name
***************
*** 28,32 ****
  # variable name.
  # <pre>
! #       &lt;ns:replace string=&quot;{any string}&quot; search=&quot;{a regexp}&quot;
  #           replace=&quot;{a string containg backreferences}&quot; var|name=&quot;var1&quot;/&gt;
  # </pre>
--- 28,32 ----
  # variable name.
  # <pre>
! #       &lt;str:replace string=&quot;{any string}&quot; search=&quot;{a regexp}&quot;
  #           replace=&quot;{a string containg backreferences}&quot; var|name=&quot;var1&quot;/&gt;
  # </pre>

[NetScript CVS] CVS: netscript2/src/perl/NetScript/Engine DOMWalker.pm,1.9,1.10

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

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

Modified Files:
	DOMWalker.pm 
Log Message:
* fixed severe bug, which obfuscated the document structure

Index: DOMWalker.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/DOMWalker.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** DOMWalker.pm	18 Sep 2002 13:19:14 -0000	1.9
--- DOMWalker.pm	24 Sep 2002 22:21:18 -0000	1.10
***************
*** 357,360 ****
--- 357,364 ----
          my $nextSource = $source -> getNextSibling();
          unless ( $nextSource ) {
+             $this -> finishNode( $source );
+             if ( $this -> sourceNodeChanged() ) {
+                 return;
+                 }
              my $parent = $source -> getParentNode();
              while ( defined( $parent ) && !defined( $nextSource ) ) {

[NetScript CVS] CVS: netscript2/src/scripts upload.xml,NONE,1.1

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

Update of /cvsroot/net-script/netscript2/src/scripts
In directory usw-pr-cvs1:/tmp/cvs-serv3674

Added Files:
	upload.xml 
Log Message:
* demo script for file upload

--- NEW FILE: upload.xml ---
<?xml version="1.0"?>
<!-- NetScript 2.0 Demo Script - Upload example -->
<html xmlns:ns="http://netscript.insomnia-hq.de">
<head>
<title>Forms Test</title>
</head>

<body bgcolor="#FFFFFF" text="#000000">
	<ns:if test="'$(P.mode)' ne 'reply'">
		Upload a file
		<form method="post" action="$(SYS.interpreterURL)" enctype="multipart/form-data">
			<input type="hidden" name="mode" value="reply"/>
			<input type="hidden" name="scriptURL" value="$(SYS.scriptURL)"/>
            <input type="file" name="myFile"/>
			<input type="submit"/>
		</form>
	</ns:if>
	<ns:else>
        Uploading...
        <ns:var name="myFile"/>
        <ns:var name="myBytes"/>
        <ns:upload directory="/home/kork/incoming" file="myFile" bytes="myBytes" parameter="myFile"/>
        Uploaded $(myFile) which had $(myBytes) bytes...
	</ns:else>
</body>
</html>

[NetScript CVS] CVS: netscript2/src/scripts wipeout.project,1.1,1.2

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

Update of /cvsroot/net-script/netscript2/src/scripts
In directory usw-pr-cvs1:/tmp/cvs-serv3593

Modified Files:
	wipeout.project 
Log Message:
* demo script for file upload

Index: wipeout.project
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/scripts/wipeout.project,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** wipeout.project	21 Aug 2002 10:41:44 -0000	1.1
--- wipeout.project	18 Sep 2002 13:21:06 -0000	1.2
***************
*** 1,248 ****
  b
! C DmDictionary 0 3a51f 8 
! c 0 3a6a2 9 
! C Category 1 38a3d 
! c 0 3a6d6 4 
! C DmString 2 3a6dd 2 e3 
! c 2 3a6dc a defaultExe 
! C DmSet 3 3a6df 1 
! c 2 38a4f 2 e3 
! L 38a4f 
! c 2 3a6de b executables 
! c 3 3a6da 3 
! c 2 38a45 3 *.C 
! L 38a45 
! c 2 38a47 4 *.cc 
! L 38a47 
! c 2 38a49 5 *.cpp 
! L 38a49 
! c 2 3a6d9 a extensions 
! c 2 3a6d8 a CPP_source 
! c 2 3a6d7 4 name 
! c 2 3a6a4 a CPP_source 
! c 1 38a53 
! c 0 3a71c 4 
! c 2 3a723 2 e3 
! c 2 3a722 a defaultExe 
! c 3 3a725 1 
! c 2 38a61 2 e3 
! L 38a61 
! c 2 3a724 b executables 
! c 3 3a720 1 
! c 2 38a5b 3 *.c 
! L 38a5b 
! c 2 3a71f a extensions 
! c 2 3a71e 8 C_source 
! c 2 3a71d 4 name 
! c 2 3a6a5 8 C_source 
! c 1 38a65 
! c 0 3a756 4 
! c 2 3a75d 2 e3 
! c 2 3a75c a defaultExe 
! c 3 3a75f 1 
! c 2 38a73 2 e3 
! L 38a73 
! c 2 3a75e b executables 
! c 3 3a75a 1 
! c 2 38a6d 3 *.e 
! L 38a6d 
! c 2 3a759 a extensions 
! c 2 3a758 6 Eiffel 
! c 2 3a757 4 name 
! c 2 3a6a6 6 Eiffel 
! c 1 38a77 
! c 0 3a790 4 
! c 2 3a797 2 e3 
! c 2 3a796 a defaultExe 
! c 3 3a799 1 
! c 2 38a8b 2 e3 
! L 38a8b 
! c 2 3a798 b executables 
! c 3 3a794 4 
! c 2 38a7f 3 *.F 
! L 38a7f 
! c 2 38a81 3 *.f 
! L 38a81 
! c 2 38a83 5 *.for 
! L 38a83 
! c 2 38a85 5 *.fpp 
! L 38a85 
! c 2 3a793 a extensions 
! c 2 3a792 7 Fortran 
! c 2 3a791 4 name 
! c 2 3a6a7 7 Fortran 
! c 1 38a8f 
! c 0 3a7d6 4 
! c 2 3a7dd 2 e3 
! c 2 3a7dc a defaultExe 
! c 3 3a7df 1 
! c 2 38a9f 2 e3 
! L 38a9f 
! c 2 3a7de b executables 
! c 3 3a7da 2 
! c 2 38a97 3 *.H 
! L 38a97 
! c 2 38a99 3 *.h 
! L 38a99 
! c 2 3a7d9 a extensions 
! c 2 3a7d8 6 Header 
! c 2 3a7d7 4 name 
! c 2 3a6a8 6 Header 
! c 1 38aa3 
! c 0 3a814 4 
! c 2 3a81b 9 surfboard 
! c 2 3a81a a defaultExe 
! c 3 3a81d 2 
! c 2 38ab3 2 e3 
! L 38ab3 
! c 2 38ab5 9 surfboard 
! L 38ab5 
! c 2 3a81c b executables 
! c 3 3a818 2 
! c 2 38aab 5 *.htm 
! L 38aab 
! c 2 38aad 6 *.html 
! L 38aad 
! c 2 3a817 a extensions 
! c 2 3a816 4 Html 
! c 2 3a815 4 name 
! c 2 3a6a9 4 Html 
! c 1 38ab9 
! c 0 3a856 4 
! c 2 3a85d 2 e3 
! c 2 3a85c a defaultExe 
! c 3 3a85f 1 
! c 2 38ac7 2 e3 
! L 38ac7 
! c 2 3a85e b executables 
! c 3 3a85a 1 
! c 2 38ac1 6 *.java 
! L 38ac1 
! c 2 3a859 a extensions 
! c 2 3a858 4 Java 
! c 2 3a857 4 name 
! c 2 3a6aa 4 Java 
! c 1 38acb 
! c 0 3a890 4 
! c 2 3a897 2 e3 
! c 2 3a896 a defaultExe 
! c 3 3a899 1 
! c 2 38ad9 2 e3 
! L 38ad9 
! c 2 3a898 b executables 
! c 3 3a894 1 
! c 2 38ad3 5 *.tex 
! L 38ad3 
! c 2 3a893 a extensions 
! c 2 3a892 5 Latex 
! c 2 3a891 4 name 
! c 2 3a6ab 5 Latex 
! c 1 38add 
! c 0 3a8ca 4 
! c 2 3a8d1 2 e3 
! c 2 3a8d0 a defaultExe 
! c 3 3a8d3 1 
! c 2 38ae8 2 e3 
! L 38ae8 
! c 2 3a8d2 b executables 
! c 3 3a8ce 0 
! c 2 3a8cd a extensions 
! c 2 3a8cc 5 Other 
! c 2 3a8cb 4 name 
! c 2 3a6ac 5 Other 
! c 2 3a6a1 a categories 
! c 0 3a6ae 1 
! C ProjectDir 4 38b09 
! c 2 38b0a 17 netscript2/src/scripts/ 11 81 
! c 2 38b0b 0  0 
! c 2 3a6b0 17 netscript2/src/scripts/ 
! c 2 3a6ad b directories 
! C DmBag 5 3a52b 7 
! c 2 3a561 da b
! C DmDictionary 0 3a52d 3 
! C DmString 1 3a53f 39 b
! C DmSet 0 38b40 1 
! C DmString 1 38b5a 5 Other 
! L 38b5a  
! c 1 3a53e a categories 
! c 1 3a52f 8 core.xml 
! c 1 3a52e 4 name 
! C DmInteger 2 3a541 1 
! c 1 3a540 9 substMode  
! c 2 3a596 de b
! C DmDictionary 0 3a562 3 
! C DmString 1 3a574 39 b
! C DmSet 0 38b72 1 
! C DmString 1 38b8c 5 Other 
! L 38b8c  
! c 1 3a573 a categories 
! c 1 3a564 c database.xml 
! c 1 3a563 4 name 
! C DmInteger 2 3a576 1 
! c 1 3a575 9 substMode  
! c 2 3a5cb db b
! C DmDictionary 0 3a597 3 
! C DmString 1 3a5a9 39 b
! C DmSet 0 38ba4 1 
! C DmString 1 38bbe 5 Other 
! L 38bbe  
! c 1 3a5a8 a categories 
! c 1 3a599 9 files.xml 
! c 1 3a598 4 name 
! C DmInteger 2 3a5ab 1 
! c 1 3a5aa 9 substMode  
! c 2 3a600 db b
! C DmDictionary 0 3a5cc 3 
! C DmString 1 3a5de 39 b
! C DmSet 0 38bd6 1 
! C DmString 1 38bf0 5 Other 
! L 38bf0  
! c 1 3a5dd a categories 
! c 1 3a5ce 9 forms.xml 
! c 1 3a5cd 4 name 
! C DmInteger 2 3a5e0 1 
! c 1 3a5df 9 substMode  
! c 2 3a635 e1 b
! C DmDictionary 0 3a601 3 
! C DmString 1 3a613 39 b
! C DmSet 0 38c08 1 
! C DmString 1 38c22 5 Other 
! L 38c22  
! c 1 3a612 a categories 
! c 1 3a603 f rimport_src.xml 
! c 1 3a602 4 name 
! C DmInteger 2 3a615 1 
! c 1 3a614 9 substMode  
! c 2 3a66a e1 b
! C DmDictionary 0 3a636 3 
! C DmString 1 3a648 39 b
! C DmSet 0 38c3a 1 
! C DmString 1 38c54 5 Other 
! L 38c54  
! c 1 3a647 a categories 
! c 1 3a638 f rimport_trg.xml 
! c 1 3a637 4 name 
! C DmInteger 2 3a64a 1 
! c 1 3a649 9 substMode  
! c 2 3a69f dd b
! C DmDictionary 0 3a66b 3 
! C DmString 1 3a67d 39 b
! C DmSet 0 38c6c 1 
! C DmString 1 38c86 5 Other 
! L 38c86  
! c 1 3a67c a categories 
! c 1 3a66d b strings.xml 
! c 1 3a66c 4 name 
! C DmInteger 2 3a67f 1 
! c 1 3a67e 9 substMode  
! c 2 3a6a0 5 files 
! c 2 3a527 94 xterm -ls -fn -*-lucidatypewriter-medium-r-normal-*-12-* -bg gray90 -T Program -geometry 80x10+0+0 -e "[set command with 'Project->Launch Command']" 
! c 2 3a526 6 launch 
! c 2 3a523 4 make 
! c 2 3a522 4 make 
! c 2 3a525 0  
! c 2 3a524 8 makeFile 
! c 5 3a528 0 
! c 2 3a52a 7 modules 
! c 2 3a521 7 scripts 
! c 2 3a520 4 name 
--- 1,259 ----
  b
! C DmDictionary 0 25f1a 8 
! c 0 260d2 9 
! C Category 1 b250 
! c 0 26106 4 
! C DmString 2 2610d 2 e3 
! c 2 2610c a defaultExe 
! C DmSet 3 2610f 1 
! c 2 b25f 2 e3 
! L b25f 
! c 2 2610e b executables 
! c 3 2610a 3 
! c 2 b266 3 *.C 
! L b266 
! c 2 b269 4 *.cc 
! L b269 
! c 2 b26c 5 *.cpp 
! L b26c 
! c 2 26109 a extensions 
! c 2 26108 a CPP_source 
! c 2 26107 4 name 
! c 2 260d4 a CPP_source 
! c 1 b281 
! c 0 2614c 4 
! c 2 26153 2 e3 
! c 2 26152 a defaultExe 
! c 3 26155 1 
! c 2 b28e 2 e3 
! L b28e 
! c 2 26154 b executables 
! c 3 26150 1 
! c 2 b295 3 *.c 
! L b295 
! c 2 2614f a extensions 
! c 2 2614e 8 C_source 
! c 2 2614d 4 name 
! c 2 260d5 8 C_source 
! c 1 b2aa 
! c 0 26186 4 
! c 2 2618d 2 e3 
! c 2 2618c a defaultExe 
! c 3 2618f 1 
! c 2 b2b7 2 e3 
! L b2b7 
! c 2 2618e b executables 
! c 3 2618a 1 
! c 2 b2be 3 *.e 
! L b2be 
! c 2 26189 a extensions 
! c 2 26188 6 Eiffel 
! c 2 26187 4 name 
! c 2 260d6 6 Eiffel 
! c 1 b2d3 
! c 0 261c0 4 
! c 2 261c7 2 e3 
! c 2 261c6 a defaultExe 
! c 3 261c9 1 
! c 2 b2e0 2 e3 
! L b2e0 
! c 2 261c8 b executables 
! c 3 261c4 4 
! c 2 b2e7 3 *.F 
! L b2e7 
! c 2 b2ea 3 *.f 
! L b2ea 
! c 2 b2ed 5 *.for 
! L b2ed 
! c 2 b2f0 5 *.fpp 
! L b2f0 
! c 2 261c3 a extensions 
! c 2 261c2 7 Fortran 
! c 2 261c1 4 name 
! c 2 260d7 7 Fortran 
! c 1 b305 
! c 0 26206 4 
! c 2 2620d 2 e3 
! c 2 2620c a defaultExe 
! c 3 2620f 1 
! c 2 b312 2 e3 
! L b312 
! c 2 2620e b executables 
! c 3 2620a 2 
! c 2 b319 3 *.H 
! L b319 
! c 2 b31c 3 *.h 
! L b31c 
! c 2 26209 a extensions 
! c 2 26208 6 Header 
! c 2 26207 4 name 
! c 2 260d8 6 Header 
! c 1 b331 
! c 0 26244 4 
! c 2 2624b 9 surfboard 
! c 2 2624a a defaultExe 
! c 3 2624d 2 
! c 2 b33e 2 e3 
! L b33e 
! c 2 b341 9 surfboard 
! L b341 
! c 2 2624c b executables 
! c 3 26248 2 
! c 2 b348 5 *.htm 
! L b348 
! c 2 b34b 6 *.html 
! L b34b 
! c 2 26247 a extensions 
! c 2 26246 4 Html 
! c 2 26245 4 name 
! c 2 260d9 4 Html 
! c 1 b360 
! c 0 26286 4 
! c 2 2628d 2 e3 
! c 2 2628c a defaultExe 
! c 3 2628f 1 
! c 2 b36d 2 e3 
! L b36d 
! c 2 2628e b executables 
! c 3 2628a 1 
! c 2 b374 6 *.java 
! L b374 
! c 2 26289 a extensions 
! c 2 26288 4 Java 
! c 2 26287 4 name 
! c 2 260da 4 Java 
! c 1 b389 
! c 0 262c0 4 
! c 2 262c7 2 e3 
! c 2 262c6 a defaultExe 
! c 3 262c9 1 
! c 2 b396 2 e3 
! L b396 
! c 2 262c8 b executables 
! c 3 262c4 1 
! c 2 b39d 5 *.tex 
! L b39d 
! c 2 262c3 a extensions 
! c 2 262c2 5 Latex 
! c 2 262c1 4 name 
! c 2 260db 5 Latex 
! c 1 b3b2 
! c 0 262fa 4 
! c 2 26301 2 e3 
! c 2 26300 a defaultExe 
! c 3 26303 1 
! c 2 b3bf 2 e3 
! L b3bf 
! c 2 26302 b executables 
! c 3 262fe 0 
! c 2 262fd a extensions 
! c 2 262fc 5 Other 
! c 2 262fb 4 name 
! c 2 260dc 5 Other 
! c 2 260d1 a categories 
! c 0 260de 1 
! C ProjectDir 4 b3dc 
! c 2 b3dd 17 netscript2/src/scripts/ 11 81 
! c 2 b3de 0  0 
! c 2 260e0 17 netscript2/src/scripts/ 
! c 2 260dd b directories 
! C DmBag 5 25f26 8 
! c 2 25f5c d7 b
! C DmDictionary 0 25f28 3 
! C DmString 1 25f3a 36 b
! C DmSet 0 b41e 1 
! C DmString 1 b44c 5 Other 
! L b44c  
! c 1 25f39 a categories 
! c 1 25f2a 8 core.xml 
! c 1 25f29 4 name 
! C DmInteger 2 25f3c 1 
! c 1 25f3b 9 substMode  
! c 2 25f91 db b
! C DmDictionary 0 25f5d 3 
! C DmString 1 25f6f 36 b
! C DmSet 0 b45d 1 
! C DmString 1 b48b 5 Other 
! L b48b  
! c 1 25f6e a categories 
! c 1 25f5f c database.xml 
! c 1 25f5e 4 name 
! C DmInteger 2 25f71 1 
! c 1 25f70 9 substMode  
! c 2 25fc6 d8 b
! C DmDictionary 0 25f92 3 
! C DmString 1 25fa4 36 b
! C DmSet 0 b49c 1 
! C DmString 1 b4ca 5 Other 
! L b4ca  
! c 1 25fa3 a categories 
! c 1 25f94 9 files.xml 
! c 1 25f93 4 name 
! C DmInteger 2 25fa6 1 
! c 1 25fa5 9 substMode  
! c 2 25ffb d8 b
! C DmDictionary 0 25fc7 3 
! C DmString 1 25fd9 36 b
! C DmSet 0 b4db 1 
! C DmString 1 b509 5 Other 
! L b509  
! c 1 25fd8 a categories 
! c 1 25fc9 9 forms.xml 
! c 1 25fc8 4 name 
! C DmInteger 2 25fdb 1 
! c 1 25fda 9 substMode  
! c 2 26030 de b
! C DmDictionary 0 25ffc 3 
! C DmString 1 2600e 36 b
! C DmSet 0 b51a 1 
! C DmString 1 b548 5 Other 
! L b548  
! c 1 2600d a categories 
! c 1 25ffe f rimport_src.xml 
! c 1 25ffd 4 name 
! C DmInteger 2 26010 1 
! c 1 2600f 9 substMode  
! c 2 26065 de b
! C DmDictionary 0 26031 3 
! C DmString 1 26043 36 b
! C DmSet 0 b559 1 
! C DmString 1 b587 5 Other 
! L b587  
! c 1 26042 a categories 
! c 1 26033 f rimport_trg.xml 
! c 1 26032 4 name 
! C DmInteger 2 26045 1 
! c 1 26044 9 substMode  
! c 2 2609a da b
! C DmDictionary 0 26066 3 
! C DmString 1 26078 36 b
! C DmSet 0 b598 1 
! C DmString 1 b5c6 5 Other 
! L b5c6  
! c 1 26077 a categories 
! c 1 26068 b strings.xml 
! c 1 26067 4 name 
! C DmInteger 2 2607a 1 
! c 1 26079 9 substMode  
! c 2 260cf dc b
! C DmDictionary 0 2609b 3 
! C DmString 1 260ad 39 b
! C DmSet 0 25db5 1 
! C DmString 1 25f0f 5 Other 
! L 25f0f  
! c 1 260ac a categories 
! c 1 2609d a upload.xml 
! c 1 2609c 4 name 
! C DmInteger 2 260af 1 
! c 1 260ae 9 substMode  
! c 2 260d0 5 files 
! c 2 25f22 94 xterm -ls -fn -*-lucidatypewriter-medium-r-normal-*-12-* -bg gray90 -T Program -geometry 80x10+0+0 -e "[set command with 'Project->Launch Command']" 
! c 2 25f21 6 launch 
! c 2 25f1e 4 make 
! c 2 25f1d 4 make 
! c 2 25f20 0  
! c 2 25f1f 8 makeFile 
! c 5 25f23 0 
! c 2 25f25 7 modules 
! c 2 25f1c 7 scripts 
! c 2 25f1b 4 name 

[NetScript CVS] CVS: netscript2/src/perl/NetScript/Libraries FormsLibrary.pm,1.5,1.6

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

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

Modified Files:
	FormsLibrary.pm 
Log Message:
* added support for file uploads

Index: FormsLibrary.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/FormsLibrary.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** FormsLibrary.pm	11 Jul 2002 22:03:10 -0000	1.5
--- FormsLibrary.pm	18 Sep 2002 13:20:09 -0000	1.6
***************
*** 94,101 ****
      my $node = $domWalker -> currentSource();
      if ( $node -> getNamespaceURI() eq $NetScript::Interpreter::NAMESPACE_URI ) {
!         if ($node -> getLocalName() eq "cookie") {
              $this -> setCookie( $node, $domWalker );
              0; # consume event
              }
          else {
              1; # do not consume event
--- 94,105 ----
      my $node = $domWalker -> currentSource();
      if ( $node -> getNamespaceURI() eq $NetScript::Interpreter::NAMESPACE_URI ) {
!         my $localName = $node -> getLocalName();
!         if ($localName eq "cookie") {
              $this -> setCookie( $node, $domWalker );
              0; # consume event
              }
+         if ( $localName eq "upload" ) {
+             $this -> doUpload( $node, $domWalker );
+             }
          else {
              1; # do not consume event
***************
*** 116,120 ****
      my $node = $domWalker -> currentSource();
      if ( $node -> getNamespaceURI() eq $NetScript::Interpreter::NAMESPACE_URI ) {
!         if ($node -> getLocalName() eq "cookie") {
              0; # consume event 
              }
--- 120,125 ----
      my $node = $domWalker -> currentSource();
      if ( $node -> getNamespaceURI() eq $NetScript::Interpreter::NAMESPACE_URI ) {
!         my $localName = $node -> getLocalName();
!         if ($localName eq "cookie" || $localName eq "upload") {
              0; # consume event 
              }
***************
*** 136,140 ****
  #*/
  sub getParameter {
!     my ( $this, $name ) = @_;
      my $cgi = $this -> interpreter() -> getCGI();
      my $pName = $name;
--- 141,145 ----
  #*/
  sub getParameter {
!     my ( $this, $member, $name ) = @_;
      my $cgi = $this -> interpreter() -> getCGI();
      my $pName = $name;
***************
*** 155,159 ****
  #*/
  sub getCookie {
!     my ( $this, $name ) = @_;
      my $cgi = $this -> interpreter() -> getCGI();
      $cgi -> cookie( $name );
--- 160,164 ----
  #*/
  sub getCookie {
!     my ( $this, $member, $name ) = @_;
      my $cgi = $this -> interpreter() -> getCGI();
      $cgi -> cookie( $name );
***************
*** 179,182 ****
--- 184,296 ----
      
      $this -> interpreter() -> setCookie( $name, $value, $expires );
+     }
+ 
+ #/** 
+ #* Uploads a file to the specified location.Puts the number of written bytes into
+ #* bytes and the filename on the server into file. Number of written bytes is
+ #* -1 if an error occured.
+ #
+ #* Attribute: parameter - name of the parameter, which contains the file
+ #* Attribute: directory - location on the server where the file should be copied to
+ #* Attribute: filename - optional, the name of file as it should be stored on the server
+ #* Attribute: limit - optional, the maximum number of 1k-blocks that should be uploaded
+ #* Attribute: bytes- optional, the name of the variable, where the number of read bytes is stored into
+ #* Attribute: file - optional, the name of the variable, where the filename on the server should be stored into.
+ #* Attribute: mode - optional, one of the following modes:
+ #*           DELETE_ON_FAIL - default, if file exceeds the set limit, file is deleted on the server.
+ #*           KEEP_ON_FAIL - file is kept, even if it was cut down to the set limit
+ #* Attribute: overwrite - optional, set to yes if existing files should be overwritten, set to no
+ #*                        if existing files should not be overwritten. If omitted, existing files will
+ #*                        NOT be overwritten. If file exists and overwrite is set to no, then 
+ #*                        the value in bytes will be set to -2 and the function will return. 
+ #*   
+ sub doUpload {
+     my ( $this, $node, $domWalker ) = @_;
+     my $se = $this -> interpreter() -> getStatementEvaluator();
+     my $aCGI =  $this -> interpreter() -> getCGI();
+     my $limit = $se -> evaluateStatement( $node -> getAttribute( "limit" ) );
+     
+     if ($limit ne "") {
+         $limit = $limit * 1024;
+         }
+     else {
+         $limit = 0;
+         }
+     
+     my $filename = $se -> evaluateStatement( $node -> getAttribute( "filename" ) );
+     my $parameter = $se -> evaluateStatement( $node -> getAttribute( "parameter" ) );
+     $filename = $aCGI -> param( $parameter ) if $filename eq '';
+     my $upload = $aCGI -> param( $parameter);        
+ 
+     # Apply filename filter to get the filename, and remove drive and path
+     
+     if ($filename =~ /([^\\\/]+)$/) {
+         $filename = $1;
+         }
+ 
+     my $directory = $se -> evaluateStatement( $node -> getAttribute( "directory" ) );
+     $filename = $directory."/".$filename;
+     my $bytes = $se -> evaluateStatement( $node -> getAttribute( "bytes" ) );
+     if (! defined($aCGI->uploadInfo($upload))) {
+         if ( $bytes ne '' ) {
+             $se -> setVariable( $bytes, -3 );
+             }
+         return;
+         }
+         
+     my $type = $aCGI -> uploadInfo($upload)->{'Content-Type'};
+ warn("[webfunctions] Info: receiving file: $upload ($type) -> $filename \n");
+     # define a buffer
+     my $buffer;     
+     my $bytesread;
+     my $overallsize = 0;
+     my $file = $se -> evaluateStatement( $node -> getAttribute( "file" ) );
+     if ($file ne '') {
+         $se -> setVariable( $file, $filename );
+         }            
+     my $overwrite = $se -> evaluateStatement( $node -> getAttribute( "overwrite" ) );
+     if ($overwrite ne 'yes' && -e $filename) {
+         if ($bytes ne '') {
+ warn("[webfunctions] Warning: file ",$filename, " does exist. File upload skipped.\n");
+             $se -> setVariable( $bytes, -2 );
+             return;
+             }
+         }
+     unless( open (OUTFILE,">$filename") ) {
+         $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
+                 $NetScript::Interpreter::FATAL_EVENT,
+                 "Cannot open $filename for writing." );
+         
+         }
+     # read in 1024b-steps
+     while ($limit == 0 || $overallsize < $limit) {
+         $bytesread=read($upload, $buffer, 1024);
+         last unless $bytesread;
+         print OUTFILE $buffer;
+         $overallsize += $bytesread;
+         }  
+     close (OUTFILE);
+     if ($limit > 0 && $bytesread >= $limit) {
+         $overallsize = -1;
+ warn("[webfunctions] Warning: file upload was cut due to a set limit of $limit.\n");    
+         my $mode = $se -> evaluateStatement( $node -> getAttribute( "mode" ) );
+         if ($mode eq 'DELETE_ON_FAIL' || $mode eq '') {
+             unlink $filename;
+ warn("[webfunctions] Info: deleted partial file $filename from server.\n");
+             }
+         elsif ($mode eq 'KEEP_ON_FAIL') {
+ warn("[webfunctions] Info: kept partial file $filename on server.\n");
+         }
+         else {
+             $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
+                 $NetScript::Interpreter::FATAL_EVENT,
+                 "$mode is no valid value for \"mode\". Use DELETE_ON_FAIL or KEEP_ON_FAIL." );
+             }
+         }
+     
+     if ( $bytes ne '' ) {
+         $se -> setVariable( $bytes, $overallsize );
+         }
+ warn("[webfunctions] Info: file upload complete. Read $overallsize bytes.\n");
      }
  

[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    

[NetScript CVS] CVS: netscript2/src/scripts wipeout.project,NONE,1.1

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

Update of /cvsroot/net-script/netscript2/src/scripts
In directory usw-pr-cvs1:/tmp/cvs-serv18691

Added Files:
	wipeout.project 
Log Message:
* demo and testing scripts

--- NEW FILE: wipeout.project ---
b
C DmDictionary 0 3a51f 8 
c 0 3a6a2 9 
C Category 1 38a3d 
c 0 3a6d6 4 
C DmString 2 3a6dd 2 e3 
c 2 3a6dc a defaultExe 
C DmSet 3 3a6df 1 
c 2 38a4f 2 e3 
L 38a4f 
c 2 3a6de b executables 
c 3 3a6da 3 
c 2 38a45 3 *.C 
L 38a45 
c 2 38a47 4 *.cc 
L 38a47 
c 2 38a49 5 *.cpp 
L 38a49 
c 2 3a6d9 a extensions 
c 2 3a6d8 a CPP_source 
c 2 3a6d7 4 name 
c 2 3a6a4 a CPP_source 
c 1 38a53 
c 0 3a71c 4 
c 2 3a723 2 e3 
c 2 3a722 a defaultExe 
c 3 3a725 1 
c 2 38a61 2 e3 
L 38a61 
c 2 3a724 b executables 
c 3 3a720 1 
c 2 38a5b 3 *.c 
L 38a5b 
c 2 3a71f a extensions 
c 2 3a71e 8 C_source 
c 2 3a71d 4 name 
c 2 3a6a5 8 C_source 
c 1 38a65 
c 0 3a756 4 
c 2 3a75d 2 e3 
c 2 3a75c a defaultExe 
c 3 3a75f 1 
c 2 38a73 2 e3 
L 38a73 
c 2 3a75e b executables 
c 3 3a75a 1 
c 2 38a6d 3 *.e 
L 38a6d 
c 2 3a759 a extensions 
c 2 3a758 6 Eiffel 
c 2 3a757 4 name 
c 2 3a6a6 6 Eiffel 
c 1 38a77 
c 0 3a790 4 
c 2 3a797 2 e3 
c 2 3a796 a defaultExe 
c 3 3a799 1 
c 2 38a8b 2 e3 
L 38a8b 
c 2 3a798 b executables 
c 3 3a794 4 
c 2 38a7f 3 *.F 
L 38a7f 
c 2 38a81 3 *.f 
L 38a81 
c 2 38a83 5 *.for 
L 38a83 
c 2 38a85 5 *.fpp 
L 38a85 
c 2 3a793 a extensions 
c 2 3a792 7 Fortran 
c 2 3a791 4 name 
c 2 3a6a7 7 Fortran 
c 1 38a8f 
c 0 3a7d6 4 
c 2 3a7dd 2 e3 
c 2 3a7dc a defaultExe 
c 3 3a7df 1 
c 2 38a9f 2 e3 
L 38a9f 
c 2 3a7de b executables 
c 3 3a7da 2 
c 2 38a97 3 *.H 
L 38a97 
c 2 38a99 3 *.h 
L 38a99 
c 2 3a7d9 a extensions 
c 2 3a7d8 6 Header 
c 2 3a7d7 4 name 
c 2 3a6a8 6 Header 
c 1 38aa3 
c 0 3a814 4 
c 2 3a81b 9 surfboard 
c 2 3a81a a defaultExe 
c 3 3a81d 2 
c 2 38ab3 2 e3 
L 38ab3 
c 2 38ab5 9 surfboard 
L 38ab5 
c 2 3a81c b executables 
c 3 3a818 2 
c 2 38aab 5 *.htm 
L 38aab 
c 2 38aad 6 *.html 
L 38aad 
c 2 3a817 a extensions 
c 2 3a816 4 Html 
c 2 3a815 4 name 
c 2 3a6a9 4 Html 
c 1 38ab9 
c 0 3a856 4 
c 2 3a85d 2 e3 
c 2 3a85c a defaultExe 
c 3 3a85f 1 
c 2 38ac7 2 e3 
L 38ac7 
c 2 3a85e b executables 
c 3 3a85a 1 
c 2 38ac1 6 *.java 
L 38ac1 
c 2 3a859 a extensions 
c 2 3a858 4 Java 
c 2 3a857 4 name 
c 2 3a6aa 4 Java 
c 1 38acb 
c 0 3a890 4 
c 2 3a897 2 e3 
c 2 3a896 a defaultExe 
c 3 3a899 1 
c 2 38ad9 2 e3 
L 38ad9 
c 2 3a898 b executables 
c 3 3a894 1 
c 2 38ad3 5 *.tex 
L 38ad3 
c 2 3a893 a extensions 
c 2 3a892 5 Latex 
c 2 3a891 4 name 
c 2 3a6ab 5 Latex 
c 1 38add 
c 0 3a8ca 4 
c 2 3a8d1 2 e3 
c 2 3a8d0 a defaultExe 
c 3 3a8d3 1 
c 2 38ae8 2 e3 
L 38ae8 
c 2 3a8d2 b executables 
c 3 3a8ce 0 
c 2 3a8cd a extensions 
c 2 3a8cc 5 Other 
c 2 3a8cb 4 name 
c 2 3a6ac 5 Other 
c 2 3a6a1 a categories 
c 0 3a6ae 1 
C ProjectDir 4 38b09 
c 2 38b0a 17 netscript2/src/scripts/ 11 81 
c 2 38b0b 0  0 
c 2 3a6b0 17 netscript2/src/scripts/ 
c 2 3a6ad b directories 
C DmBag 5 3a52b 7 
c 2 3a561 da b
C DmDictionary 0 3a52d 3 
C DmString 1 3a53f 39 b
C DmSet 0 38b40 1 
C DmString 1 38b5a 5 Other 
L 38b5a  
c 1 3a53e a categories 
c 1 3a52f 8 core.xml 
c 1 3a52e 4 name 
C DmInteger 2 3a541 1 
c 1 3a540 9 substMode  
c 2 3a596 de b
C DmDictionary 0 3a562 3 
C DmString 1 3a574 39 b
C DmSet 0 38b72 1 
C DmString 1 38b8c 5 Other 
L 38b8c  
c 1 3a573 a categories 
c 1 3a564 c database.xml 
c 1 3a563 4 name 
C DmInteger 2 3a576 1 
c 1 3a575 9 substMode  
c 2 3a5cb db b
C DmDictionary 0 3a597 3 
C DmString 1 3a5a9 39 b
C DmSet 0 38ba4 1 
C DmString 1 38bbe 5 Other 
L 38bbe  
c 1 3a5a8 a categories 
c 1 3a599 9 files.xml 
c 1 3a598 4 name 
C DmInteger 2 3a5ab 1 
c 1 3a5aa 9 substMode  
c 2 3a600 db b
C DmDictionary 0 3a5cc 3 
C DmString 1 3a5de 39 b
C DmSet 0 38bd6 1 
C DmString 1 38bf0 5 Other 
L 38bf0  
c 1 3a5dd a categories 
c 1 3a5ce 9 forms.xml 
c 1 3a5cd 4 name 
C DmInteger 2 3a5e0 1 
c 1 3a5df 9 substMode  
c 2 3a635 e1 b
C DmDictionary 0 3a601 3 
C DmString 1 3a613 39 b
C DmSet 0 38c08 1 
C DmString 1 38c22 5 Other 
L 38c22  
c 1 3a612 a categories 
c 1 3a603 f rimport_src.xml 
c 1 3a602 4 name 
C DmInteger 2 3a615 1 
c 1 3a614 9 substMode  
c 2 3a66a e1 b
C DmDictionary 0 3a636 3 
C DmString 1 3a648 39 b
C DmSet 0 38c3a 1 
C DmString 1 38c54 5 Other 
L 38c54  
c 1 3a647 a categories 
c 1 3a638 f rimport_trg.xml 
c 1 3a637 4 name 
C DmInteger 2 3a64a 1 
c 1 3a649 9 substMode  
c 2 3a69f dd b
C DmDictionary 0 3a66b 3 
C DmString 1 3a67d 39 b
C DmSet 0 38c6c 1 
C DmString 1 38c86 5 Other 
L 38c86  
c 1 3a67c a categories 
c 1 3a66d b strings.xml 
c 1 3a66c 4 name 
C DmInteger 2 3a67f 1 
c 1 3a67e 9 substMode  
c 2 3a6a0 5 files 
c 2 3a527 94 xterm -ls -fn -*-lucidatypewriter-medium-r-normal-*-12-* -bg gray90 -T Program -geometry 80x10+0+0 -e "[set command with 'Project->Launch Command']" 
c 2 3a526 6 launch 
c 2 3a523 4 make 
c 2 3a522 4 make 
c 2 3a525 0  
c 2 3a524 8 makeFile 
c 5 3a528 0 
c 2 3a52a 7 modules 
c 2 3a521 7 scripts 
c 2 3a520 4 name 

[NetScript CVS] CVS: netscript2/src/scripts - Imported sources

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

Update of /cvsroot/net-script/netscript2/src/scripts
In directory usw-pr-cvs1:/tmp/cvs-serv18086

Log Message:
 

Status:

Vendor Tag:	tag1
Release Tags:	tag2
		
N netscript2/src/scripts/strings.xml
N netscript2/src/scripts/rimport_src.xml
N netscript2/src/scripts/rimport_trg.xml
N netscript2/src/scripts/core.xml
N netscript2/src/scripts/database.xml
N netscript2/src/scripts/files.xml
N netscript2/src/scripts/forms.xml

No conflicts created by this import


***** Bogus filespec: - Imported sources

[NetScript CVS] CVS: netscript2/src/perl/XML/DOM2 XMLDOMWriterStyle.pm,1.5,1.6

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

Update of /cvsroot/net-script/netscript2/src/perl/XML/DOM2
In directory usw-pr-cvs1:/tmp/cvs-serv17260

Modified Files:
	XMLDOMWriterStyle.pm 
Log Message:
* fixed a bug causing content from the last operation to be appended to content from the current operation

Index: XMLDOMWriterStyle.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/XML/DOM2/XMLDOMWriterStyle.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** XMLDOMWriterStyle.pm	8 Jun 2002 12:14:29 -0000	1.5
--- XMLDOMWriterStyle.pm	21 Aug 2002 10:37:49 -0000	1.6
***************
*** 41,45 ****
--- 41,54 ----
  sub init {
      my ($this) = @_;
+     $this -> clear();
      $this -> appendText( "<?xml version=\"1.0\"?>\n" );
+     }
+ 
+ #/**
+ # Zeroes the internal string representation of the DOM.
+ #*/
+ sub clear {
+     my ( $this ) = @_;
+     $this -> { m_representation } = ""; #empty!
      }
  

[NetScript CVS] CVS: netscript2/src/perl/XML/DOM2 PlainXMLDOMWriterStyle.pm,NONE,1.1

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

Update of /cvsroot/net-script/netscript2/src/perl/XML/DOM2
In directory usw-pr-cvs1:/tmp/cvs-serv16832

Added Files:
	PlainXMLDOMWriterStyle.pm 
Log Message:
* new Style just plain converting DOM to XML with no specialties

--- NEW FILE: PlainXMLDOMWriterStyle.pm ---
#--------------------------------------------------------
# DOM Level 2 Implementation for Perl
# $Id: PlainXMLDOMWriterStyle.pm,v 1.1 2002/08/21 10:36:51 derkork Exp $
# 
# DOM2 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;
package XML::DOM2::PlainXMLDOMWriterStyle;
use base qw(XML::DOM2::XMLDOMWriterStyle);

#--------------------------------------------------------
# Methods
#--------------------------------------------------------

#/**
# Creates a new PlainXMLDOMWriterStyle. This style produces XML for each Node.
# However it does not provide any XML semantics (especially no <?xml ?> PI)
# @return an instance of XML::DOM2::DOMWriter
# @public
#*/
sub new {
    my ($proto) = shift;
    my $class = ref( $proto ) || $proto;# get the Classname

    # Create a Class using the Hash-As-An-Object-Idiom
    my $this = $class -> SUPER::new();
    return $this;
    }
 
#/**
# Initialises the DOMWriterStyle.
# @public
#*/
sub init {
    my ($this) = @_;
    $this -> clear();
    }

1; # make require happy

[NetScript CVS] CVS: netscript2/src/perl/XML/DOM2 wipeout.project,1.9,1.10

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

Update of /cvsroot/net-script/netscript2/src/perl/XML/DOM2
In directory usw-pr-cvs1:/tmp/cvs-serv16766

Modified Files:
	wipeout.project 
Log Message:
* new Style just plain converting DOM to XML with no specialties

Index: wipeout.project
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/XML/DOM2/wipeout.project,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** wipeout.project	8 Jun 2002 12:27:03 -0000	1.9
--- wipeout.project	21 Aug 2002 10:36:42 -0000	1.10
***************
*** 1,446 ****
  b
! C DmDictionary 0 2f442 8 
! c 0 2f97f 9 
! C Category 1 9c82 
! c 0 2f9bf 4 
! C DmString 2 2f9c6 2 e3 
! c 2 2f9c5 a defaultExe 
! C DmSet 3 2f9c8 1 
! c 2 9c91 2 e3 
! L 9c91 
! c 2 2f9c7 b executables 
! c 3 2f9c3 3 
! c 2 9c98 3 *.C 
! L 9c98 
! c 2 9c9b 4 *.cc 
! L 9c9b 
! c 2 9c9e 5 *.cpp 
! L 9c9e 
! c 2 2f9c2 a extensions 
! c 2 2f9c1 a CPP_source 
! c 2 2f9c0 4 name 
! c 2 2f981 a CPP_source 
! c 1 9cb3 
! c 0 2fa05 4 
! c 2 2fa0c 2 e3 
! c 2 2fa0b a defaultExe 
! c 3 2fa0e 1 
! c 2 9cc0 2 e3 
! L 9cc0 
! c 2 2fa0d b executables 
! c 3 2fa09 1 
! c 2 9cc7 3 *.c 
! L 9cc7 
! c 2 2fa08 a extensions 
! c 2 2fa07 8 C_source 
! c 2 2fa06 4 name 
! c 2 2f982 8 C_source 
! c 1 9cdc 
! c 0 2fa3f 4 
! c 2 2fa46 2 e3 
! c 2 2fa45 a defaultExe 
! c 3 2fa48 1 
! c 2 9ce9 2 e3 
! L 9ce9 
! c 2 2fa47 b executables 
! c 3 2fa43 1 
! c 2 9cf0 3 *.e 
! L 9cf0 
! c 2 2fa42 a extensions 
! c 2 2fa41 6 Eiffel 
! c 2 2fa40 4 name 
! c 2 2f983 6 Eiffel 
! c 1 9d05 
! c 0 2fa79 4 
! c 2 2fa80 2 e3 
! c 2 2fa7f a defaultExe 
! c 3 2fa82 1 
! c 2 9d12 2 e3 
! L 9d12 
! c 2 2fa81 b executables 
! c 3 2fa7d 4 
! c 2 9d19 3 *.F 
! L 9d19 
! c 2 9d1c 3 *.f 
! L 9d1c 
! c 2 9d1f 5 *.for 
! L 9d1f 
! c 2 9d22 5 *.fpp 
! L 9d22 
! c 2 2fa7c a extensions 
! c 2 2fa7b 7 Fortran 
! c 2 2fa7a 4 name 
! c 2 2f984 7 Fortran 
! c 1 9d37 
! c 0 2fabf 4 
! c 2 2fac6 2 e3 
! c 2 2fac5 a defaultExe 
! c 3 2fac8 1 
! c 2 9d44 2 e3 
! L 9d44 
! c 2 2fac7 b executables 
! c 3 2fac3 2 
! c 2 9d4b 3 *.H 
! L 9d4b 
! c 2 9d4e 3 *.h 
! L 9d4e 
! c 2 2fac2 a extensions 
! c 2 2fac1 6 Header 
! c 2 2fac0 4 name 
! c 2 2f985 6 Header 
! c 1 9d63 
! c 0 2fafd 4 
! c 2 2fb04 9 surfboard 
! c 2 2fb03 a defaultExe 
! c 3 2fb06 2 
! c 2 9d70 2 e3 
! L 9d70 
! c 2 9d73 9 surfboard 
! L 9d73 
! c 2 2fb05 b executables 
! c 3 2fb01 2 
! c 2 9d7a 5 *.htm 
! L 9d7a 
! c 2 9d7d 6 *.html 
! L 9d7d 
! c 2 2fb00 a extensions 
! c 2 2faff 4 Html 
! c 2 2fafe 4 name 
! c 2 2f986 4 Html 
! c 1 9d92 
! c 0 2fb3f 4 
! c 2 2fb46 2 e3 
! c 2 2fb45 a defaultExe 
! c 3 2fb48 1 
! c 2 9d9f 2 e3 
! L 9d9f 
! c 2 2fb47 b executables 
! c 3 2fb43 1 
! c 2 9da6 6 *.java 
! L 9da6 
! c 2 2fb42 a extensions 
! c 2 2fb41 4 Java 
! c 2 2fb40 4 name 
! c 2 2f987 4 Java 
! c 1 9dbb 
! c 0 2fb79 4 
! c 2 2fb80 2 e3 
! c 2 2fb7f a defaultExe 
! c 3 2fb82 1 
! c 2 9dc8 2 e3 
! L 9dc8 
! c 2 2fb81 b executables 
! c 3 2fb7d 1 
! c 2 9dcf 5 *.tex 
! L 9dcf 
! c 2 2fb7c a extensions 
! c 2 2fb7b 5 Latex 
! c 2 2fb7a 4 name 
! c 2 2f988 5 Latex 
! c 1 9de4 
! c 0 2fbb3 4 
! c 2 2fbba 2 e3 
! c 2 2fbb9 a defaultExe 
! c 3 2fbbc 1 
! c 2 9df1 2 e3 
! L 9df1 
! c 2 2fbbb b executables 
! c 3 2fbb7 0 
! c 2 2fbb6 a extensions 
! c 2 2fbb5 5 Other 
! c 2 2fbb4 4 name 
! c 2 2f989 5 Other 
! c 2 2f97e a categories 
! c 0 2f98b 1 
! C ProjectDir 4 9e0e 
! c 2 9e0f 1d netscript2/src/perl/XML/DOM2/ 11 81 
! c 2 9e10 0  0 
! c 2 2f98d 1d netscript2/src/perl/XML/DOM2/ 
! c 2 2f98a b directories 
! C DmBag 5 2f44e 19 
! c 2 2f484 d6 b
! C DmDictionary 0 2f450 3 
! C DmString 1 2f462 36 b
! C DmSet 0 9e74 1 
! C DmString 1 9ea2 5 Other 
! L 9ea2  
! c 1 2f461 a categories 
! c 1 2f452 7 Attr.pm 
! c 1 2f451 4 name 
! C DmInteger 2 2f464 1 
! c 1 2f463 9 substMode  
! c 2 2f4b9 de b
! C DmDictionary 0 2f485 3 
! C DmString 1 2f497 36 b
! C DmSet 0 9eb3 1 
! C DmString 1 9ee1 5 Other 
! L 9ee1  
! c 1 2f496 a categories 
! c 1 2f487 f CDATASection.pm 
! c 1 2f486 4 name 
! C DmInteger 2 2f499 1 
! c 1 2f498 9 substMode  
! c 2 2f4ee df b
! C DmDictionary 0 2f4ba 3 
! C DmString 1 2f4cc 36 b
! C DmSet 0 9ef2 1 
! C DmString 1 9f20 5 Other 
! L 9f20  
! c 1 2f4cb a categories 
! c 1 2f4bc 9 CHANGELOG 
! c 1 2f4bb 4 name 
! C DmInteger 2 2f4ce 80000001 
! c 1 2f4cd 9 substMode  
! c 2 2f523 e0 b
! C DmDictionary 0 2f4ef 3 
! C DmString 1 2f501 36 b
! C DmSet 0 9f31 1 
! C DmString 1 9f5f 5 Other 
! L 9f5f  
! c 1 2f500 a categories 
! c 1 2f4f1 10 CharacterData.pm 
! c 1 2f4f0 4 name 
! C DmInteger 2 2f503 1 
! c 1 2f502 9 substMode  
! c 2 2f558 d9 b
! C DmDictionary 0 2f524 3 
! C DmString 1 2f536 36 b
! C DmSet 0 9f70 1 
! C DmString 1 9f9e 5 Other 
! L 9f9e  
! c 1 2f535 a categories 
! c 1 2f526 a Comment.pm 
! c 1 2f525 4 name 
! C DmInteger 2 2f538 1 
! c 1 2f537 9 substMode  
! c 2 2f58d de b
! C DmDictionary 0 2f559 3 
! C DmString 1 2f56b 36 b
! C DmSet 0 9faf 1 
! C DmString 1 9fdd 5 Other 
! L 9fdd  
! c 1 2f56a a categories 
! c 1 2f55b f DOMException.pm 
! c 1 2f55a 4 name 
! C DmInteger 2 2f56d 1 
! c 1 2f56c 9 substMode  
! c 2 2f5c2 e4 b
! C DmDictionary 0 2f58e 3 
! C DmString 1 2f5a0 36 b
! C DmSet 0 9fee 1 
! C DmString 1 a01c 5 Other 
! L a01c  
! c 1 2f59f a categories 
! c 1 2f590 14 DOMImplementation.pm 
! c 1 2f58f 4 name 
! C DmInteger 2 2f5a2 1 
! c 1 2f5a1 9 substMode  
! c 2 2f5f7 db b
! C DmDictionary 0 2f5c3 3 
! C DmString 1 2f5d5 36 b
! C DmSet 0 a02d 1 
! C DmString 1 a05b 5 Other 
! L a05b  
! c 1 2f5d4 a categories 
! c 1 2f5c5 c DOMParser.pm 
! c 1 2f5c4 4 name 
! C DmInteger 2 2f5d7 1 
! c 1 2f5d6 9 substMode  
! c 2 2f62c e1 b
! C DmDictionary 0 2f5f8 3 
! C DmString 1 2f60a 36 b
! C DmSet 0 a06c 1 
! C DmString 1 a09a 5 Other 
! L a09a  
! c 1 2f609 a categories 
! c 1 2f5fa 11 DOMParserStyle.pm 
! c 1 2f5f9 4 name 
! C DmInteger 2 2f60c 1 
! c 1 2f60b 9 substMode  
! c 2 2f661 db b
! C DmDictionary 0 2f62d 3 
! C DmString 1 2f63f 36 b
! C DmSet 0 a0ab 1 
! C DmString 1 a0d9 5 Other 
! L a0d9  
! c 1 2f63e a categories 
! c 1 2f62f c DOMWriter.pm 
! c 1 2f62e 4 name 
! C DmInteger 2 2f641 1 
! c 1 2f640 9 substMode  
! c 2 2f696 e1 b
! C DmDictionary 0 2f662 3 
! C DmString 1 2f674 36 b
! C DmSet 0 a0ea 1 
! C DmString 1 a118 5 Other 
! L a118  
! c 1 2f673 a categories 
! c 1 2f664 11 DOMWriterStyle.pm 
! c 1 2f663 4 name 
! C DmInteger 2 2f676 1 
! c 1 2f675 9 substMode  
! c 2 2f6cb da b
! C DmDictionary 0 2f697 3 
! C DmString 1 2f6a9 36 b
! C DmSet 0 a129 1 
! C DmString 1 a157 5 Other 
! L a157  
! c 1 2f6a8 a categories 
! c 1 2f699 b Document.pm 
! c 1 2f698 4 name 
! C DmInteger 2 2f6ab 1 
! c 1 2f6aa 9 substMode  
! c 2 2f700 e3 b
! C DmDictionary 0 2f6cc 3 
! C DmString 1 2f6de 36 b
! C DmSet 0 a168 1 
! C DmString 1 a196 5 Other 
! L a196  
! c 1 2f6dd a categories 
! c 1 2f6ce 13 DocumentFragment.pm 
! c 1 2f6cd 4 name 
! C DmInteger 2 2f6e0 1 
! c 1 2f6df 9 substMode  
! c 2 2f735 de b
! C DmDictionary 0 2f701 3 
! C DmString 1 2f713 36 b
! C DmSet 0 a1a7 1 
! C DmString 1 a1d5 5 Other 
! L a1d5  
! c 1 2f712 a categories 
! c 1 2f703 f DocumentType.pm 
! c 1 2f702 4 name 
! C DmInteger 2 2f715 1 
! c 1 2f714 9 substMode  
! c 2 2f76a d9 b
! C DmDictionary 0 2f736 3 
! C DmString 1 2f748 36 b
! C DmSet 0 a1e6 1 
! C DmString 1 a214 5 Other 
! L a214  
! c 1 2f747 a categories 
! c 1 2f738 a Element.pm 
! c 1 2f737 4 name 
! C DmInteger 2 2f74a 1 
! c 1 2f749 9 substMode  
! c 2 2f79f d8 b
! C DmDictionary 0 2f76b 3 
! C DmString 1 2f77d 36 b
! C DmSet 0 a225 1 
! C DmString 1 a253 5 Other 
! L a253  
! c 1 2f77c a categories 
! c 1 2f76d 9 Entity.pm 
! c 1 2f76c 4 name 
! C DmInteger 2 2f77f 1 
! c 1 2f77e 9 substMode  
! c 2 2f7d4 e2 b
! C DmDictionary 0 2f7a0 3 
! C DmString 1 2f7b2 36 b
! C DmSet 0 a264 1 
! C DmString 1 a292 5 Other 
! L a292  
! c 1 2f7b1 a categories 
! c 1 2f7a2 12 EntityReference.pm 
! c 1 2f7a1 4 name 
! C DmInteger 2 2f7b4 1 
! c 1 2f7b3 9 substMode  
! c 2 2f809 de b
! C DmDictionary 0 2f7d5 3 
! C DmString 1 2f7e7 36 b
! C DmSet 0 a2a3 1 
! C DmString 1 a2d1 5 Other 
! L a2d1  
! c 1 2f7e6 a categories 
! c 1 2f7d7 f NamedNodeMap.pm 
! c 1 2f7d6 4 name 
! C DmInteger 2 2f7e9 1 
! c 1 2f7e8 9 substMode  
! c 2 2f83e d6 b
! C DmDictionary 0 2f80a 3 
! C DmString 1 2f81c 36 b
! C DmSet 0 a2e2 1 
! C DmString 1 a310 5 Other 
! L a310  
! c 1 2f81b a categories 
! c 1 2f80c 7 Node.pm 
! c 1 2f80b 4 name 
! C DmInteger 2 2f81e 1 
! c 1 2f81d 9 substMode  
! c 2 2f873 da b
! C DmDictionary 0 2f83f 3 
! C DmString 1 2f851 36 b
! C DmSet 0 a321 1 
! C DmString 1 a34f 5 Other 
! L a34f  
! c 1 2f850 a categories 
! c 1 2f841 b NodeList.pm 
! c 1 2f840 4 name 
! C DmInteger 2 2f853 1 
! c 1 2f852 9 substMode  
! c 2 2f8a8 da b
! C DmDictionary 0 2f874 3 
! C DmString 1 2f886 36 b
! C DmSet 0 a360 1 
! C DmString 1 a38e 5 Other 
! L a38e  
! c 1 2f885 a categories 
! c 1 2f876 b Notation.pm 
! c 1 2f875 4 name 
! C DmInteger 2 2f888 1 
! c 1 2f887 9 substMode  
! c 2 2f8dd e8 b
! C DmDictionary 0 2f8a9 3 
! C DmString 1 2f8bb 36 b
! C DmSet 0 a39f 1 
! C DmString 1 a3cd 5 Other 
! L a3cd  
! c 1 2f8ba a categories 
! c 1 2f8ab 18 ProcessingInstruction.pm 
! c 1 2f8aa 4 name 
! C DmInteger 2 2f8bd 1 
! c 1 2f8bc 9 substMode  
! c 2 2f912 d6 b
! C DmDictionary 0 2f8de 3 
! C DmString 1 2f8f0 36 b
! C DmSet 0 a3de 1 
! C DmString 1 a40c 5 Other 
! L a40c  
! c 1 2f8ef a categories 
! c 1 2f8e0 7 Text.pm 
! c 1 2f8df 4 name 
! C DmInteger 2 2f8f2 1 
! c 1 2f8f1 9 substMode  
! c 2 2f947 e4 b
! C DmDictionary 0 2f913 3 
! C DmString 1 2f925 36 b
! C DmSet 0 a41d 1 
! C DmString 1 a44b 5 Other 
! L a44b  
! c 1 2f924 a categories 
! c 1 2f915 14 XMLDOMWriterStyle.pm 
! c 1 2f914 4 name 
! C DmInteger 2 2f927 1 
! c 1 2f926 9 substMode  
! c 2 2f97c d8 b
! C DmDictionary 0 2f948 3 
! C DmString 1 2f95a 36 b
! C DmSet 0 a45c 1 
! C DmString 1 a48a 5 Other 
! L a48a  
! c 1 2f959 a categories 
! c 1 2f94a 9 notes.txt 
! c 1 2f949 4 name 
! C DmInteger 2 2f95c 1 
! c 1 2f95b 9 substMode  
! c 2 2f97d 5 files 
! c 2 2f44a 94 xterm -ls -fn -*-lucidatypewriter-medium-r-normal-*-12-* -bg gray90 -T Program -geometry 80x10+0+0 -e "[set command with 'Project->Launch Command']" 
! c 2 2f449 6 launch 
! c 2 2f446 4 make 
! c 2 2f445 4 make 
! c 2 2f448 0  
! c 2 2f447 8 makeFile 
! c 5 2f44b 0 
! c 2 2f44d 7 modules 
! c 2 2f444 4 DOM2 
! c 2 2f443 4 name 
--- 1,457 ----
  b
! C DmDictionary 0 364da 8 
! c 0 36a4c 9 
! C Category 1 9e40 
! c 0 36a8c 4 
! C DmString 2 36a93 2 e3 
! c 2 36a92 a defaultExe 
! C DmSet 3 36a95 1 
! c 2 9e4f 2 e3 
! L 9e4f 
! c 2 36a94 b executables 
! c 3 36a90 3 
! c 2 9e56 3 *.C 
! L 9e56 
! c 2 9e59 4 *.cc 
! L 9e59 
! c 2 9e5c 5 *.cpp 
! L 9e5c 
! c 2 36a8f a extensions 
! c 2 36a8e a CPP_source 
! c 2 36a8d 4 name 
! c 2 36a4e a CPP_source 
! c 1 9e71 
! c 0 36ad2 4 
! c 2 36ad9 2 e3 
! c 2 36ad8 a defaultExe 
! c 3 36adb 1 
! c 2 9e7e 2 e3 
! L 9e7e 
! c 2 36ada b executables 
! c 3 36ad6 1 
! c 2 9e85 3 *.c 
! L 9e85 
! c 2 36ad5 a extensions 
! c 2 36ad4 8 C_source 
! c 2 36ad3 4 name 
! c 2 36a4f 8 C_source 
! c 1 9e9a 
! c 0 36b0c 4 
! c 2 36b13 2 e3 
! c 2 36b12 a defaultExe 
! c 3 36b15 1 
! c 2 9ea7 2 e3 
! L 9ea7 
! c 2 36b14 b executables 
! c 3 36b10 1 
! c 2 9eae 3 *.e 
! L 9eae 
! c 2 36b0f a extensions 
! c 2 36b0e 6 Eiffel 
! c 2 36b0d 4 name 
! c 2 36a50 6 Eiffel 
! c 1 9ec3 
! c 0 36b46 4 
! c 2 36b4d 2 e3 
! c 2 36b4c a defaultExe 
! c 3 36b4f 1 
! c 2 9ed0 2 e3 
! L 9ed0 
! c 2 36b4e b executables 
! c 3 36b4a 4 
! c 2 9ed7 3 *.F 
! L 9ed7 
! c 2 9eda 3 *.f 
! L 9eda 
! c 2 9edd 5 *.for 
! L 9edd 
! c 2 9ee0 5 *.fpp 
! L 9ee0 
! c 2 36b49 a extensions 
! c 2 36b48 7 Fortran 
! c 2 36b47 4 name 
! c 2 36a51 7 Fortran 
! c 1 9ef5 
! c 0 36b8c 4 
! c 2 36b93 2 e3 
! c 2 36b92 a defaultExe 
! c 3 36b95 1 
! c 2 9f02 2 e3 
! L 9f02 
! c 2 36b94 b executables 
! c 3 36b90 2 
! c 2 9f09 3 *.H 
! L 9f09 
! c 2 9f0c 3 *.h 
! L 9f0c 
! c 2 36b8f a extensions 
! c 2 36b8e 6 Header 
! c 2 36b8d 4 name 
! c 2 36a52 6 Header 
! c 1 9f21 
! c 0 36bca 4 
! c 2 36bd1 9 surfboard 
! c 2 36bd0 a defaultExe 
! c 3 36bd3 2 
! c 2 9f2e 2 e3 
! L 9f2e 
! c 2 9f31 9 surfboard 
! L 9f31 
! c 2 36bd2 b executables 
! c 3 36bce 2 
! c 2 9f38 5 *.htm 
! L 9f38 
! c 2 9f3b 6 *.html 
! L 9f3b 
! c 2 36bcd a extensions 
! c 2 36bcc 4 Html 
! c 2 36bcb 4 name 
! c 2 36a53 4 Html 
! c 1 9f50 
! c 0 36c0c 4 
! c 2 36c13 2 e3 
! c 2 36c12 a defaultExe 
! c 3 36c15 1 
! c 2 9f5d 2 e3 
! L 9f5d 
! c 2 36c14 b executables 
! c 3 36c10 1 
! c 2 9f64 6 *.java 
! L 9f64 
! c 2 36c0f a extensions 
! c 2 36c0e 4 Java 
! c 2 36c0d 4 name 
! c 2 36a54 4 Java 
! c 1 9f79 
! c 0 36c46 4 
! c 2 36c4d 2 e3 
! c 2 36c4c a defaultExe 
! c 3 36c4f 1 
! c 2 9f86 2 e3 
! L 9f86 
! c 2 36c4e b executables 
! c 3 36c4a 1 
! c 2 9f8d 5 *.tex 
! L 9f8d 
! c 2 36c49 a extensions 
! c 2 36c48 5 Latex 
! c 2 36c47 4 name 
! c 2 36a55 5 Latex 
! c 1 9fa2 
! c 0 36c80 4 
! c 2 36c87 2 e3 
! c 2 36c86 a defaultExe 
! c 3 36c89 1 
! c 2 9faf 2 e3 
! L 9faf 
! c 2 36c88 b executables 
! c 3 36c84 0 
! c 2 36c83 a extensions 
! c 2 36c82 5 Other 
! c 2 36c81 4 name 
! c 2 36a56 5 Other 
! c 2 36a4b a categories 
! c 0 36a58 1 
! C ProjectDir 4 9fcc 
! c 2 9fcd 1d netscript2/src/perl/XML/DOM2/ 11 81 
! c 2 9fce 0  0 
! c 2 36a5a 1d netscript2/src/perl/XML/DOM2/ 
! c 2 36a57 b directories 
! C DmBag 5 364e6 1a 
! c 2 3651c d6 b
! C DmDictionary 0 364e8 3 
! C DmString 1 364fa 36 b
! C DmSet 0 a032 1 
! C DmString 1 a060 5 Other 
! L a060  
! c 1 364f9 a categories 
! c 1 364ea 7 Attr.pm 
! c 1 364e9 4 name 
! C DmInteger 2 364fc 1 
! c 1 364fb 9 substMode  
! c 2 36551 de b
! C DmDictionary 0 3651d 3 
! C DmString 1 3652f 36 b
! C DmSet 0 a071 1 
! C DmString 1 a09f 5 Other 
! L a09f  
! c 1 3652e a categories 
! c 1 3651f f CDATASection.pm 
! c 1 3651e 4 name 
! C DmInteger 2 36531 1 
! c 1 36530 9 substMode  
! c 2 36586 df b
! C DmDictionary 0 36552 3 
! C DmString 1 36564 36 b
! C DmSet 0 a0b0 1 
! C DmString 1 a0de 5 Other 
! L a0de  
! c 1 36563 a categories 
! c 1 36554 9 CHANGELOG 
! c 1 36553 4 name 
! C DmInteger 2 36566 80000001 
! c 1 36565 9 substMode  
! c 2 365bb e0 b
! C DmDictionary 0 36587 3 
! C DmString 1 36599 36 b
! C DmSet 0 a0ef 1 
! C DmString 1 a11d 5 Other 
! L a11d  
! c 1 36598 a categories 
! c 1 36589 10 CharacterData.pm 
! c 1 36588 4 name 
! C DmInteger 2 3659b 1 
! c 1 3659a 9 substMode  
! c 2 365f0 d9 b
! C DmDictionary 0 365bc 3 
! C DmString 1 365ce 36 b
! C DmSet 0 a12e 1 
! C DmString 1 a15c 5 Other 
! L a15c  
! c 1 365cd a categories 
! c 1 365be a Comment.pm 
! c 1 365bd 4 name 
! C DmInteger 2 365d0 1 
! c 1 365cf 9 substMode  
! c 2 36625 de b
! C DmDictionary 0 365f1 3 
! C DmString 1 36603 36 b
! C DmSet 0 a16d 1 
! C DmString 1 a19b 5 Other 
! L a19b  
! c 1 36602 a categories 
! c 1 365f3 f DOMException.pm 
! c 1 365f2 4 name 
! C DmInteger 2 36605 1 
! c 1 36604 9 substMode  
! c 2 3665a e4 b
! C DmDictionary 0 36626 3 
! C DmString 1 36638 36 b
! C DmSet 0 a1ac 1 
! C DmString 1 a1da 5 Other 
! L a1da  
! c 1 36637 a categories 
! c 1 36628 14 DOMImplementation.pm 
! c 1 36627 4 name 
! C DmInteger 2 3663a 1 
! c 1 36639 9 substMode  
! c 2 3668f db b
! C DmDictionary 0 3665b 3 
! C DmString 1 3666d 36 b
! C DmSet 0 a1eb 1 
! C DmString 1 a219 5 Other 
! L a219  
! c 1 3666c a categories 
! c 1 3665d c DOMParser.pm 
! c 1 3665c 4 name 
! C DmInteger 2 3666f 1 
! c 1 3666e 9 substMode  
! c 2 366c4 e1 b
! C DmDictionary 0 36690 3 
! C DmString 1 366a2 36 b
! C DmSet 0 a22a 1 
! C DmString 1 a258 5 Other 
! L a258  
! c 1 366a1 a categories 
! c 1 36692 11 DOMParserStyle.pm 
! c 1 36691 4 name 
! C DmInteger 2 366a4 1 
! c 1 366a3 9 substMode  
! c 2 366f9 db b
! C DmDictionary 0 366c5 3 
! C DmString 1 366d7 36 b
! C DmSet 0 a269 1 
! C DmString 1 a297 5 Other 
! L a297  
! c 1 366d6 a categories 
! c 1 366c7 c DOMWriter.pm 
! c 1 366c6 4 name 
! C DmInteger 2 366d9 1 
! c 1 366d8 9 substMode  
! c 2 3672e e1 b
! C DmDictionary 0 366fa 3 
! C DmString 1 3670c 36 b
! C DmSet 0 a2a8 1 
! C DmString 1 a2d6 5 Other 
! L a2d6  
! c 1 3670b a categories 
! c 1 366fc 11 DOMWriterStyle.pm 
! c 1 366fb 4 name 
! C DmInteger 2 3670e 1 
! c 1 3670d 9 substMode  
! c 2 36763 da b
! C DmDictionary 0 3672f 3 
! C DmString 1 36741 36 b
! C DmSet 0 a2e7 1 
! C DmString 1 a315 5 Other 
! L a315  
! c 1 36740 a categories 
! c 1 36731 b Document.pm 
! c 1 36730 4 name 
! C DmInteger 2 36743 1 
! c 1 36742 9 substMode  
! c 2 36798 e3 b
! C DmDictionary 0 36764 3 
! C DmString 1 36776 36 b
! C DmSet 0 a326 1 
! C DmString 1 a354 5 Other 
! L a354  
! c 1 36775 a categories 
! c 1 36766 13 DocumentFragment.pm 
! c 1 36765 4 name 
! C DmInteger 2 36778 1 
! c 1 36777 9 substMode  
! c 2 367cd de b
! C DmDictionary 0 36799 3 
! C DmString 1 367ab 36 b
! C DmSet 0 a365 1 
! C DmString 1 a393 5 Other 
! L a393  
! c 1 367aa a categories 
! c 1 3679b f DocumentType.pm 
! c 1 3679a 4 name 
! C DmInteger 2 367ad 1 
! c 1 367ac 9 substMode  
! c 2 36802 d9 b
! C DmDictionary 0 367ce 3 
! C DmString 1 367e0 36 b
! C DmSet 0 a3a4 1 
! C DmString 1 a3d2 5 Other 
! L a3d2  
! c 1 367df a categories 
! c 1 367d0 a Element.pm 
! c 1 367cf 4 name 
! C DmInteger 2 367e2 1 
! c 1 367e1 9 substMode  
! c 2 36837 d8 b
! C DmDictionary 0 36803 3 
! C DmString 1 36815 36 b
! C DmSet 0 a3e3 1 
! C DmString 1 a411 5 Other 
! L a411  
! c 1 36814 a categories 
! c 1 36805 9 Entity.pm 
! c 1 36804 4 name 
! C DmInteger 2 36817 1 
! c 1 36816 9 substMode  
! c 2 3686c e2 b
! C DmDictionary 0 36838 3 
! C DmString 1 3684a 36 b
! C DmSet 0 a422 1 
! C DmString 1 a450 5 Other 
! L a450  
! c 1 36849 a categories 
! c 1 3683a 12 EntityReference.pm 
! c 1 36839 4 name 
! C DmInteger 2 3684c 1 
! c 1 3684b 9 substMode  
! c 2 368a1 de b
! C DmDictionary 0 3686d 3 
! C DmString 1 3687f 36 b
! C DmSet 0 a461 1 
! C DmString 1 a48f 5 Other 
! L a48f  
! c 1 3687e a categories 
! c 1 3686f f NamedNodeMap.pm 
! c 1 3686e 4 name 
! C DmInteger 2 36881 1 
! c 1 36880 9 substMode  
! c 2 368d6 d6 b
! C DmDictionary 0 368a2 3 
! C DmString 1 368b4 36 b
! C DmSet 0 a4a0 1 
! C DmString 1 a4ce 5 Other 
! L a4ce  
! c 1 368b3 a categories 
! c 1 368a4 7 Node.pm 
! c 1 368a3 4 name 
! C DmInteger 2 368b6 1 
! c 1 368b5 9 substMode  
! c 2 3690b da b
! C DmDictionary 0 368d7 3 
! C DmString 1 368e9 36 b
! C DmSet 0 a4df 1 
! C DmString 1 a50d 5 Other 
! L a50d  
! c 1 368e8 a categories 
! c 1 368d9 b NodeList.pm 
! c 1 368d8 4 name 
! C DmInteger 2 368eb 1 
! c 1 368ea 9 substMode  
! c 2 36940 da b
! C DmDictionary 0 3690c 3 
! C DmString 1 3691e 36 b
! C DmSet 0 a51e 1 
! C DmString 1 a54c 5 Other 
! L a54c  
! c 1 3691d a categories 
! c 1 3690e b Notation.pm 
! c 1 3690d 4 name 
! C DmInteger 2 36920 1 
! c 1 3691f 9 substMode  
! c 2 36975 ec b
! C DmDictionary 0 36941 3 
! C DmString 1 36953 39 b
! C DmSet 0 36355 1 
! C DmString 1 364cf 5 Other 
! L 364cf  
! c 1 36952 a categories 
! c 1 36943 19 PlainXMLDOMWriterStyle.pm 
! c 1 36942 4 name 
! C DmInteger 2 36955 1 
! c 1 36954 9 substMode  
! c 2 369aa e8 b
! C DmDictionary 0 36976 3 
! C DmString 1 36988 36 b
! C DmSet 0 a55d 1 
! C DmString 1 a58b 5 Other 
! L a58b  
! c 1 36987 a categories 
! c 1 36978 18 ProcessingInstruction.pm 
! c 1 36977 4 name 
! C DmInteger 2 3698a 1 
! c 1 36989 9 substMode  
! c 2 369df d6 b
! C DmDictionary 0 369ab 3 
! C DmString 1 369bd 36 b
! C DmSet 0 a59c 1 
! C DmString 1 a5ca 5 Other 
! L a5ca  
! c 1 369bc a categories 
! c 1 369ad 7 Text.pm 
! c 1 369ac 4 name 
! C DmInteger 2 369bf 1 
! c 1 369be 9 substMode  
! c 2 36a14 e4 b
! C DmDictionary 0 369e0 3 
! C DmString 1 369f2 36 b
! C DmSet 0 a5db 1 
! C DmString 1 a609 5 Other 
! L a609  
! c 1 369f1 a categories 
! c 1 369e2 14 XMLDOMWriterStyle.pm 
! c 1 369e1 4 name 
! C DmInteger 2 369f4 1 
! c 1 369f3 9 substMode  
! c 2 36a49 d8 b
! C DmDictionary 0 36a15 3 
! C DmString 1 36a27 36 b
! C DmSet 0 a61a 1 
! C DmString 1 a648 5 Other 
! L a648  
! c 1 36a26 a categories 
! c 1 36a17 9 notes.txt 
! c 1 36a16 4 name 
! C DmInteger 2 36a29 1 
! c 1 36a28 9 substMode  
! c 2 36a4a 5 files 
! c 2 364e2 94 xterm -ls -fn -*-lucidatypewriter-medium-r-normal-*-12-* -bg gray90 -T Program -geometry 80x10+0+0 -e "[set command with 'Project->Launch Command']" 
! c 2 364e1 6 launch 
! c 2 364de 4 make 
! c 2 364dd 4 make 
! c 2 364e0 0  
! c 2 364df 8 makeFile 
! c 5 364e3 0 
! c 2 364e5 7 modules 
! c 2 364dc 4 DOM2 
! c 2 364db 4 name 

[NetScript CVS] CVS: netscript2/src/perl/NetScript/Libraries FilesLibrary.pm,NONE,1.1

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

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

Added Files:
	FilesLibrary.pm 
Log Message:
* new library for reading and writing files

--- NEW FILE: FilesLibrary.pm ---
#--------------------------------------------------------
# $Id: FilesLibrary.pm,v 1.1 2002/08/21 10:35:46 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 file operations.
# To load this library put the following statements into the netscript:
# <pre>
#       &lt;?netscript use Files?&gt;
# </pre>
# Add the following attribute to your document element:
# <pre>
#       &lt;yourdocumentelement xmlns:str=&quot;http://files.netscript.insomnia-hq.de&quot;/&gt;
# </pre>
# <pre>
#       &lt;files:redirect-output filename=&quot;{filename}&quot; 
#               [append=&quot;yes|no&quot;]
#               [toOutput=&quot;yes|no&quot;]&gt;
#           &lt;any&gt;&lt;code&gt;&lt;here&gt;&lt;/here&gt;&lt;/code&gt;&lt;/any&gt;
#       &lt;/files:redirect-output&gt;
# </pre>        
# Redirects all output between the tag to the given file. If toOutput is
# set to "yes", the output will also be routed to the 
# standard output (most often the browser), else it will be just put into 
# the file and not be sent to the browser. 
# Note that the file is locked exclusively for the redirect.
# If append is set to "yes" the output will be appended to the file, instead
# of replacing the original content of the file.
# <pre>
#       &lt;files:open filename=&quot;{filename}&quot; handle=&quot;{name of the filehandle}&quot;
#               mode=&quot;{r|w|a|rw}&quot; [lock=&quot;{shared|exclusive}]&quot;&gt;
#           &lt;any&gt;&lt;file&gt;&lt;operation&gt;&lt;here&gt;&lt;/here&gt;&lt;/operation&gt;&lt;/file&gt;&lt;/any&gt;
#       &lt;/file:open&gt;
# </pre>
# Opens the given file and assigns it to the given handle. You can set
# the mode to read ("r"), write ("w"), append("a") or read and write ("rw"). 
# As an optional argument you can tell if the file should be locked either 
# in shared mode ( that means, other processes can read but not write ) or 
# exclusive mode( that means, other processes can neither read nor write ). 
# File will be closed when the closing open-tag is reached. Note that using 
# one of the writing modes, the file will be created if necessary. If
# using the "w"-mode, file will be truncated to zero length before writing.
# Note that if using the locking modes, the command will block until a lock
# has been established.
# <pre>
#       &lt;files:read handle=&quot;{name of the filehandle}&quot; bytes=&quot;{a number}&quot;
#               name|var=&quot;{variable name}&quot;/&gt;
# </pre>
# Reads the specified number of bytes from the given file. If the file end
# is encountered, then reading will stop there. Read contents will be put
# into the given variable.
# <pre>
#       &lt;files:readlns handle=&quot;{name of the filehandle}&quot;
#               name|var=&quot;{variable name}&quot; 
#               [lines=&quot;{number of lines to read}&quot;]
#               [from=&quot;{index in array where to start}&quot;]/&gt;
# </pre>
# Reads the specified number of lines from the file and puts them into an array.
# If the lines-attribute is omitted, it reads all lines from the file into
# the array. The from attribute specifies, at which index in the array the
# read lines should start. If omitted, 0 is assumed.
# <pre>
#       &lt;files:write handle=&quot;{name of the filehandle}&quot;
#               var=&quot;{variable name}&quot;/&gt;
# </pre>
# Writes the content of the given variable to the given file. If variable
# is an array, all array members will be written to the file.
#
#*/
package NetScript::Libraries::FilesLibrary;
use base qw(NetScript::Libraries::Library);

use NetScript::Engine::EventListener;
use NetScript::Engine::EventRelay;
use NetScript::Interpreter;
use NetScript::Engine::DOMWalker;
use XML::DOM2::DOMWriter;
use XML::DOM2::PlainXMLDOMWriterStyle;

use vars qw( $FILES_NAMESPACE_URI );

$FILES_NAMESPACE_URI="http://files.netscript.insomnia-hq.de";

#/**
# Ctor. 
# @public
#*/
sub new {
    my $proto = shift;                  # get Prototype
    my $class = ref($proto) || $proto;
    my $this = $class -> SUPER::new();
    
    my %openFiles = ();
    my @redirectNodes = ();
    my @processedNodes = ();
    $this -> { m_openFiles } = \%openFiles;
    $this -> { m_redirectNodes } = \@redirectNodes;
    $this -> { m_processedNodes } = \@processedNodes;
    $this -> { m_isRedirectOpen } = 0;
    $this;
    }


sub init {
    my ($this, $interpreter) = @_;
    $this -> SUPER::init( $interpreter );
    # 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 $eventListener3 = NetScript::Engine::EventListener -> new();
    $eventListener3 -> init(
            $NetScript::Engine::DOMWalker::DOCUMENT_END_EVENT,
            "documentFinished", $this );

    my $eventRelay = $this -> interpreter() -> getEventRelay();
    $eventRelay -> addEventListener( $eventListener1 );
    $eventRelay -> addEventListener( $eventListener2 );
    $eventRelay -> addEventListener( $eventListener3 );
    }

#/**
# Returns the name of the filehandle, specified on the
# given node. Throws an error if no filehandle is specified
# on the given node.
# @private
# @param the node to scan
# @return the file handle
#*/
sub getFileHandle {
    my ( $this, $node ) = @_;
    my $se = $this -> interpreter() -> getStatementEvaluator();
    my $handleName = $node -> getAttribute( "handle" );
    $handleName = $se -> evaluateStatement( $handleName );
    if ( $handleName eq "" ) {
        $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
            $NetScript::Interpreter::FATAL_EVENT,
            "You did not specify a file handle!");
        }
    $handleName;
    }


#/**
# Opens the given file.
# @param an instance of XML::DOM2::Element
# @param an instance of NetScript::Engine::DOMWalker
#*/
sub doOpen {
    my ( $this, $node, $domWalker ) = @_;
    my $se = $this -> interpreter() -> getStatementEvaluator();
    my $handle = $this -> getFileHandle( $node );
    my $mode = $node -> getAttribute( "mode" );
    my $locking = $node -> getAttribute( "lock" );
    my $filename = $node -> getAttribute( "filename" );
    
    $mode = $se -> evaluateStatement( $mode );
    $locking = $se -> evaluateStatement( $locking );
    $filename = $se -> evaluateStatement( $filename );

    if ( $filename eq "" ) {
        $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                $NetScript::Interpreter::FATAL_EVENT,
                "You must specify a filename." );
        }
    

    my $filehandle = $this -> { m_openFiles } -> { $handle };
    if ( defined( $filehandle ) ) {
        $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                $NetScript::Interpreter::FATAL_EVENT,
                "The handle \"$handle\" is already in use. Use another one." );
        }

    # open file in requested mode    
    if ( $mode eq "r" ) {
        open( $filehandle, "<$filename"  ) or
            $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                    $NetScript::Interpreter::FATAL_EVENT,
                    "Unable to open \"$filename\" for reading, maybe it doesnt exist or lacks the necessary permissions." );
        }
    
    elsif ( $mode eq "w" ) {
        open( $filehandle, ">$filename" ) or
            $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                    $NetScript::Interpreter::FATAL_EVENT,
                    "Unable to open \"$filename\" for writing, maybe it lacks the necessary permissions." );
        }
    
    elsif ( $mode eq "a") {
        open( $filehandle, ">>$filename" ) or
            $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                    $NetScript::Interpreter::FATAL_EVENT,
                    "Unable to open \"$filename\" for appending, maybe it lacks the necessary permissions." );
        }

    elsif ( $mode eq "rw" ) {
        open( $filehandle, "+<$filename" ) or
            $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                    $NetScript::Interpreter::FATAL_EVENT,
                    "Unable to open \"$filename\" for read/write, maybe it doesn't exist orlacks the necessary permissions." );
        }
    else {
        $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                $NetScript::Interpreter::FATAL_EVENT,
                $mode eq "" ? "You must specify an opening mode!" :
                "Unknown opening mode \"$mode\". Specify one of \"r\", \"w\", \"rw\" or \"a\"!" );
        }

    # Do file lock if requested
    if ( $locking eq "shared" ) {
        # Shared lock = 1 
        flock( $filehandle, 1 ) or
            $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                    $NetScript::Interpreter::FATAL_EVENT,
                    "Cannot acquire a shared lock on $filename!" );
        }
    elsif ( $locking eq "exclusive" ) {
        # Exclusive lock = 2
        flock ( $filehandle, 2 ) or
            $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                    $NetScript::Interpreter::FATAL_EVENT,
                    "Cannot acquire an exclusive lock on $filename!" );
        }
    $this -> { m_openFiles } -> { $handle } = $filehandle;
    $domWalker -> stepSourceIn();
    }

#/**
# Writes to the open file with the given handle.
# @param an instance of XML:DOM2::Element
# @param an instance of NetScript::Engine::DOMWalker
#*/
sub doWrite {
    my ( $this, $node, $domWalker ) = @_;
    my $se = $this -> interpreter() -> getStatementEvaluator();
    my $handle = $this -> getFileHandle( $node );
    my $variable = $node -> getAttribute( "var" );
    
    if ( $variable eq "" ) {
        $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                $NetScript::Interpreter::FATAL_EVENT,
                "You did not specify a variable!" );
        }
    
    my $fileHandle = $this -> { m_openFiles } -> { $handle };
    if ( ! defined( $fileHandle ) ) {
        $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                $NetScript::Interpreter::FATAL_EVENT,
                "There is no filehandle \"$handle\"!" );
        }
    
    my $value = $se -> resolveObjectValue( $variable );
    print { $fileHandle } $value;
    $domWalker -> stepSourceNext();
    }

#/**
# Reads from the open file with the given file handle.
# @param an instance of XML:DOM2::Element
# @param an instance of NetScript::Engine::DOMWalker
#*/
sub doRead {
    my ( $this, $node, $domWalker ) = @-;
    my $se = $this -> interpreter() -> getStatementEvaluator();
    my $handle = $this -> getFileHandle( $node );
    my ($create, $variable) = $this -> getVariableInfo( $node );
    my $length = $se -> evaluateStatement( $node -> getAttribute( "bytes" ) );

    unless( $length =~ /^[0-9]+$/ ) {
        $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                $NetScript::Interpreter::FATAL_EVENT,
                "Invalid value for bytes : \"$length\"!" );
        }
    
    my $fileHandle = $this -> { m_openFiles } -> { $handle };
    if ( ! defined( $fileHandle ) ) {
        $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                $NetScript::Interpreter::FATAL_EVENT,
                "There is no filehandle \"$handle\"!" );
        }

    my $value;
    # read from file
    read( $fileHandle, $value, $length );
    # set variable
    if ( $create ) {
        $se -> createVariable( $variable, $value );
        }
    else {
        $se -> setVariable( $variable, $value );
        }

    $domWalker -> stepSourceNext();
    }

#/**
# Reads the specified number of lines from the given file
# @param an instance of XML:DOM2::Element
# @param an instance of NetScript::Engine::DOMWalker
#*/
sub doReadlns {
    my ( $this, $node, $domWalker ) = @_;
    my $se = $this -> interpreter() -> getStatementEvaluator();
    my $handle = $this -> getFileHandle( $node );
    my ($create, $variable) = $this -> getVariableInfo( $node );
    my $count = $se -> evaluateStatement( $node -> getAttribute( "lines" ) );
    my $index = $se -> evaluateStatement( $node -> getAttribute( "from" ) );
    my $fileHandle = $this -> { m_openFiles } -> { $handle };
    if ( ! defined( $fileHandle ) ) {
        $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                $NetScript::Interpreter::FATAL_EVENT,
                "There is no filehandle \"$handle\"!" );
        }

    if ( $create  ) {
        $se -> createVariable( "$variable:!" );
        }

    if ( $index eq "" ) {
        $index = 0;
        }
    
    if ( $count eq "" ) {
        my $idx = $index;
        while( <$fileHandle> ) {
            $se -> setVariable( "$variable:$idx", $_ );
            $idx ++;
            }
        }
    else {
        my $idx = $index;
        my $read = 0;
        while ( $read < $count  ) {
            my $val = <$fileHandle>;
            if ( $val ) {
                $se -> setVariable( "$variable:$idx", $val );
                $idx ++;
                $read ++;
                }
            else {
                last;
                }
            }
        }
    
    $domWalker -> stepSourceNext();
    }

#/**
# Saves the output-tag so output can be redirected later.
# 
#*/
sub doRedirectOutput {
    my ( $this, $node, $domWalker ) = @_;
    if ( $this -> { m_isRedirectOpen } ) {
        $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                $NetScript::Interpreter::FATAL_EVENT,
                "You must not nest \"redirect-output\" tags!" );
        }
    $this -> { m_isRedirectOpen } = 1;
    my $se = $this -> interpreter() -> getStatementEvaluator();
    my $filename = $se -> evaluateStatement( $node -> getAttribute( "filename" ) );
    if ( $filename eq "" ) {
        $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                $NetScript::Interpreter::FATAL_EVENT,
                "You must specify a filename to export to!" );
        }
    
    my $targetNode = $domWalker -> insertIntoTarget( $node, 1 );
    push( @{ $this -> { m_redirectNodes } }, $targetNode );
    push( @{ $this -> { m_processedNodes } }, $targetNode );
    $domWalker -> stepSourceIn();
    }

#/**
# Called when redirect-output ends.
#*/
sub doRedirectOutputFinish {
    my ( $this, $aNode, $domWalker ) = @_;
    my $se = $this -> interpreter() -> getStatementEvaluator();
    my $domWriter = XML::DOM2::DOMWriter -> new();
    my $style = XML::DOM2::PlainXMLDOMWriterStyle -> new();

    my $node = pop( @{ $this -> { m_redirectNodes } } );
    my $filename = $se -> evaluateStatement( $node -> getAttribute( "filename" ) );
    my $append = $se -> evaluateStatement( $node -> getAttribute( "append" ) );
    
    
    open( AFILE, $append eq "yes" ? ">>$filename" : ">$filename" ) or
        $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                $NetScript::Interpreter::FATAL_EVENT,
                "Cannot open \"$filename\". Maybe it lacks the necessary permissions." );
    flock( AFILE, 2 ) or
        $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                $NetScript::Interpreter::FATAL_EVENT,
                "Cannot lock \"$filename\"." );
    my $children = $node -> getChildNodes();
    my $len = $children -> getLength() - 1;
    for ( 0..$len ) {
        my $child = $children -> item( $_ );
        my $value = $domWriter -> writeDOMToString( $child, $style );
        print AFILE $value;    
        }
    
    flock( AFILE, 8 ) or
        $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                $NetScript::Interpreter::FATAL_EVENT,
                "Cannot unlock \"$filename\"." );
    close( AFILE ) or 
        $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                $NetScript::Interpreter::FATAL_EVENT,
                "Cannot close \"$filename\"!" );

    $this -> { m_isRedirectOpen } = 0;
    $domWalker -> stepTargetUp();
    }

#/**
# Closes the open file.
# @param an instance of XML:DOM2::Element
# @param an instance of NetScript::Engine::DOMWalker
#*/
sub doClose {
    my ( $this, $node, $domWalker ) = @_;
    my $handle = $this -> getFileHandle( $node );
    
    my $fileHandle = $this -> { m_openFiles } -> { $handle };
    if ( ! defined( $fileHandle ) ) {
        $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                $NetScript::Interpreter::FATAL_EVENT,
                "There is no filehandle \"$handle\"!" );
        }
    
    my $lock = $node -> getAttribute( "lock" );
    if ( $lock ne "" ) {
        flock( $fileHandle, 8 ) or 
            $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                    $NetScript::Interpreter::FATAL_EVENT,
                    "Cannot unlock file with handle \"$handle\"!" );
        }
    
    close( $fileHandle ) or
            $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                $NetScript::Interpreter::FATAL_EVENT,
                "Cannot close the file with handle \"$handle\"!" );
    delete $this -> { m_openFiles } -> { $handle };
    }

#/**
# Called upon element start
# @callback
#*/
sub elementStarted {
    my ( $this, $event ) = @_;
    my $domWalker = $event -> getEventUnknown();
    my $node = $domWalker -> currentSource();
    if ( $node -> getNamespaceURI() eq $FILES_NAMESPACE_URI ) {
        my $name = $node -> getLocalName();
        if ( $name eq "open" ) {
            $this -> doOpen( $node, $domWalker );
            0;
            }
        elsif ( $name eq "read" ) {
            $this -> doRead( $node, $domWalker );
            0;
            }
        elsif ( $name eq "write" ) {
            $this -> doWrite( $node, $domWalker );
            0;
            }
        elsif ( $name eq "readlns" ) {
            $this -> doReadlns( $node, $domWalker );
            0;
            }
        elsif ( $name eq "redirect-output" ) {
            $this -> doRedirectOutput( $node, $domWalker );
            0;
            }
        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 -> getEventUnknown();
    my $node = $domWalker -> currentSource();
    if ( $node -> getNamespaceURI() eq $FILES_NAMESPACE_URI ) {
        my $name = $node -> getLocalName();
        if ($name eq "read"  || $name eq "readlns" || $name eq "write" ||
                $name eq "seek"  ) {
            0; # consume event 
            }
        elsif ( $name eq "open" ) {
            $this -> doClose( $node, $domWalker );
            0;
            }
        elsif ( $name eq "redirect-output" ) {
            $this -> doRedirectOutputFinish( $node, $domWalker );
            0;
            }
        else {
            1; # do not consume
            }
        }
    else {
        1; # do not consume event
        }
    }

#/**
# The document is finished, now we can do our remaining output.
#*/ 
sub documentFinished {
    my ( $this, $event ) = @_;
    my $domWalker = $event -> getEventUnknown();
    my @nodes = @{ $this -> { m_processedNodes } };
    my $se = $this -> interpreter() -> getStatementEvaluator();
    
    for ( @nodes ) {
        my $node = $_;
        my $export = $se -> evaluateStatement( $node -> getAttribute( "toOutput" ) );
        
        
        if ( $export eq "yes" ) {
            my $parent = $node -> getParentNode();
            my $children = $node -> getChildNodes();
            my $len = $children -> getLength() -1;
            
            # parent node must be an element
            if ( defined( $node ) && $node -> getNodeType() == 
                    $XML::DOM2::Node::ELEMENT_NODE ) {
                
                for ( 0..$len ) {
                    my $child = $children -> item( 0 );
                    $parent -> insertBefore( $child, $node );
                    }
                $parent -> removeChild( $node );
                }
            # XXX: A bit strange but what should i do ?
            # else keep it that way... 
            }
        else {
            # Remove node from target document
            my $parent = $node -> getParentNode();
            $parent -> removeChild( $node );
            }
        }
    1; # do not consume!
    }

sub shutdown {
    my ($this) = @_;
    $this -> SUPER::shutdown();
    }

sub getName {
    "Files Library";
    }

sub getVersion {
    1.0;
    }

sub getDescription {
    "This Library provides file functions.";
    }
1; #make require happy

[NetScript CVS] CVS: netscript2/src/perl/NetScript/Libraries DebugLibrary.pm,1.6,1.7

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

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

Modified Files:
	DebugLibrary.pm 
Log Message:


Index: DebugLibrary.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/DebugLibrary.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** DebugLibrary.pm	7 Jul 2002 14:34:37 -0000	1.6
--- DebugLibrary.pm	21 Aug 2002 10:35:03 -0000	1.7
***************
*** 60,63 ****
--- 60,64 ----
              $NetScript::Libraries::DebugLibrary::DEBUG_EVENT,
              "debugEvent", $this );
+             
      my $eventRelay = $this -> interpreter() -> getEventRelay();
      $eventRelay -> addEventListener( $eventListener1 );

[NetScript CVS] CVS: netscript2/src/perl/NetScript/Libraries DatabaseLibrary.pm,1.1,1.2

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

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

Modified Files:
	DatabaseLibrary.pm 
Log Message:
* changed interface to be consistent in all libraries

Index: DatabaseLibrary.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/DatabaseLibrary.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** DatabaseLibrary.pm	7 Aug 2002 20:13:55 -0000	1.1
--- DatabaseLibrary.pm	21 Aug 2002 10:34:44 -0000	1.2
***************
*** 24,28 ****
  # <pre>
  #   &lt;db:settings
! #           name=&quot;MyDBSettings&quot;
  #           host=&quot;host.to.your.db&quot;
  #           database=&quot;database-name&quot;
--- 24,28 ----
  # <pre>
  #   &lt;db:settings
! #           handle=&quot;MyDBSettings&quot;
  #           host=&quot;host.to.your.db&quot;
  #           database=&quot;database-name&quot;
***************
*** 35,39 ****
  # getting a resultset. This is done in the following way:
  # <pre>
! #   &lt;db:exec db=&quot;MyDBSettings&quot; 
  #       query=&quot;{SQL-QUERY HERE}&quot; [{name|var}=&quot;{Variable here}&quot];/&gt;
  # </pre>
--- 35,39 ----
  # getting a resultset. This is done in the following way:
  # <pre>
! #   &lt;db:exec handle=&quot;MyDBSettings&quot; 
  #       query=&quot;{SQL-QUERY HERE}&quot; [{name|var}=&quot;{Variable here}&quot];/&gt;
  # </pre>
***************
*** 58,64 ****
  #   <pre>
  #       &lt;example&gt;
! #           &lt;db:settings name=&quot;myDB&quot;
  #                   host=&quot;my.db.com&quot;
- #                   port=&quot;6666&quot;
  #                   database=&quot;KorksDB&quot;
  #                   type=&quot;MySQL&quot;
--- 58,63 ----
  #   <pre>
  #       &lt;example&gt;
! #           &lt;db:settings handle=&quot;myDB&quot;
  #                   host=&quot;my.db.com&quot;
  #                   database=&quot;KorksDB&quot;
  #                   type=&quot;MySQL&quot;
***************
*** 147,155 ****
      $settings{ "password" } = $node -> getAttribute( "password" );
      $settings{ "database" } = $node -> getAttribute( "database" );
!     my $name = $node -> getAttribute( "name" );
      unless( defined( $name ) ) {
          $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                  $NetScript::Interpreter::FATAL_EVENT, 
!                 "You must specify a name for your DB-Settings." );
          return;                
          }
--- 146,154 ----
      $settings{ "password" } = $node -> getAttribute( "password" );
      $settings{ "database" } = $node -> getAttribute( "database" );
!     my $name = $node -> getAttribute( "handle" );
      unless( defined( $name ) ) {
          $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                  $NetScript::Interpreter::FATAL_EVENT, 
!                 "You must specify a handle for your DB-Settings." );
          return;                
          }
***************
*** 165,169 ****
  sub runStatement {
      my ( $this, $domWalker, $node )  = @_;
!     my $dbName = $node -> getAttribute( "db" );
      if ( $dbName eq "" ) {
          $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
--- 164,168 ----
  sub runStatement {
      my ( $this, $domWalker, $node )  = @_;
!     my $dbName = $node -> getAttribute( "handle" );
      if ( $dbName eq "" ) {
          $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(

[NetScript CVS] CVS: netscript2/src/perl/NetScript/Libraries wipeout.project,1.7,1.8

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

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

Modified Files:
	wipeout.project 
Log Message:
* changed interface to be consistent in all libraries

Index: wipeout.project
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/wipeout.project,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** wipeout.project	14 Aug 2002 22:23:25 -0000	1.7
--- wipeout.project	21 Aug 2002 10:34:34 -0000	1.8
***************
*** 1,270 ****
  b
! C DmDictionary 0 538e2 8 
! c 0 53acf 9 
! C Category 1 7ae1 
! c 0 53b0f 4 
! C DmString 2 53b16 2 e3 
! c 2 53b15 a defaultExe 
! C DmSet 3 53b18 1 
! c 2 7af0 2 e3 
! L 7af0 
! c 2 53b17 b executables 
! c 3 53b13 3 
! c 2 7af7 3 *.C 
! L 7af7 
! c 2 7afa 4 *.cc 
  L 7afa 
! c 2 7afd 5 *.cpp 
! L 7afd 
! c 2 53b12 a extensions 
! c 2 53b11 a CPP_source 
! c 2 53b10 4 name 
! c 2 53ad1 a CPP_source 
! c 1 7b12 
! c 0 53b55 4 
! c 2 53b5c 2 e3 
! c 2 53b5b a defaultExe 
! c 3 53b5e 1 
! c 2 7b1f 2 e3 
! L 7b1f 
! c 2 53b5d b executables 
! c 3 53b59 1 
! c 2 7b26 3 *.c 
! L 7b26 
! c 2 53b58 a extensions 
! c 2 53b57 8 C_source 
! c 2 53b56 4 name 
! c 2 53ad2 8 C_source 
! c 1 7b3b 
! c 0 53b8f 4 
! c 2 53b96 2 e3 
! c 2 53b95 a defaultExe 
! c 3 53b98 1 
! c 2 7b48 2 e3 
! L 7b48 
! c 2 53b97 b executables 
! c 3 53b93 1 
! c 2 7b4f 3 *.e 
! L 7b4f 
! c 2 53b92 a extensions 
! c 2 53b91 6 Eiffel 
! c 2 53b90 4 name 
! c 2 53ad3 6 Eiffel 
! c 1 7b64 
! c 0 53bc9 4 
! c 2 53bd0 2 e3 
! c 2 53bcf a defaultExe 
! c 3 53bd2 1 
! c 2 7b71 2 e3 
! L 7b71 
! c 2 53bd1 b executables 
! c 3 53bcd 4 
! c 2 7b78 3 *.F 
! L 7b78 
! c 2 7b7b 3 *.f 
  L 7b7b 
! c 2 7b7e 5 *.for 
! L 7b7e 
! c 2 7b81 5 *.fpp 
! L 7b81 
! c 2 53bcc a extensions 
! c 2 53bcb 7 Fortran 
! c 2 53bca 4 name 
! c 2 53ad4 7 Fortran 
! c 1 7b96 
! c 0 53c0f 4 
! c 2 53c16 2 e3 
! c 2 53c15 a defaultExe 
! c 3 53c18 1 
! c 2 7ba3 2 e3 
! L 7ba3 
! c 2 53c17 b executables 
! c 3 53c13 2 
! c 2 7baa 3 *.H 
! L 7baa 
! c 2 7bad 3 *.h 
  L 7bad 
! c 2 53c12 a extensions 
! c 2 53c11 6 Header 
! c 2 53c10 4 name 
! c 2 53ad5 6 Header 
! c 1 7bc2 
! c 0 53c4d 4 
! c 2 53c54 9 surfboard 
! c 2 53c53 a defaultExe 
! c 3 53c56 2 
! c 2 7bcf 2 e3 
! L 7bcf 
! c 2 7bd2 9 surfboard 
! L 7bd2 
! c 2 53c55 b executables 
! c 3 53c51 2 
! c 2 7bd9 5 *.htm 
  L 7bd9 
! c 2 7bdc 6 *.html 
  L 7bdc 
! c 2 53c50 a extensions 
! c 2 53c4f 4 Html 
! c 2 53c4e 4 name 
! c 2 53ad6 4 Html 
! c 1 7bf1 
! c 0 53c8f 4 
! c 2 53c96 2 e3 
! c 2 53c95 a defaultExe 
! c 3 53c98 1 
! c 2 7bfe 2 e3 
! L 7bfe 
! c 2 53c97 b executables 
! c 3 53c93 1 
! c 2 7c05 6 *.java 
! L 7c05 
! c 2 53c92 a extensions 
! c 2 53c91 4 Java 
! c 2 53c90 4 name 
! c 2 53ad7 4 Java 
! c 1 7c1a 
! c 0 53cc9 4 
! c 2 53cd0 2 e3 
! c 2 53ccf a defaultExe 
! c 3 53cd2 1 
! c 2 7c27 2 e3 
! L 7c27 
! c 2 53cd1 b executables 
! c 3 53ccd 1 
! c 2 7c2e 5 *.tex 
! L 7c2e 
! c 2 53ccc a extensions 
! c 2 53ccb 5 Latex 
! c 2 53cca 4 name 
! c 2 53ad8 5 Latex 
! c 1 7c43 
! c 0 53d03 4 
! c 2 53d0a 2 e3 
! c 2 53d09 a defaultExe 
! c 3 53d0c 1 
! c 2 7c50 2 e3 
! L 7c50 
! c 2 53d0b b executables 
! c 3 53d07 0 
! c 2 53d06 a extensions 
! c 2 53d05 5 Other 
! c 2 53d04 4 name 
! c 2 53ad9 5 Other 
! c 2 53ace a categories 
! c 0 53adb 1 
! C ProjectDir 4 7c6d 
! c 2 7c6e 28 netscript2/src/perl/NetScript/Libraries/ 11 81 
! c 2 7c6f 0  0 
! c 2 53add 28 netscript2/src/perl/NetScript/Libraries/ 
! c 2 53ada b directories 
! C DmBag 5 538ee 9 
! c 2 53924 de b
! C DmDictionary 0 538f0 3 
! C DmString 1 53902 36 b
! C DmSet 0 7cb1 1 
! C DmString 1 7cdf 5 Other 
! L 7cdf  
! c 1 53901 a categories 
! c 1 538f2 f ClassLibrary.pm 
! c 1 538f1 4 name 
! C DmInteger 2 53904 1 
! c 1 53903 9 substMode  
! c 2 53959 eb b
! C DmDictionary 0 53925 3 
! C DmString 1 53937 36 b
! C DmSet 0 7cf0 1 
! C DmString 1 7d1e 5 Other 
! L 7d1e  
! c 1 53936 a categories 
! c 1 53927 1b ControlStructuresLibrary.pm 
! c 1 53926 4 name 
! C DmInteger 2 53939 1 
! c 1 53938 9 substMode  
! c 2 5398e e2 b
! C DmDictionary 0 5395a 3 
! C DmString 1 5396c 36 b
! C DmSet 0 7d2f 1 
! C DmString 1 7d5d 5 Other 
! L 7d5d  
! c 1 5396b a categories 
! c 1 5395c 12 DatabaseLibrary.pm 
! c 1 5395b 4 name 
! C DmInteger 2 5396e 1 
! c 1 5396d 9 substMode  
! c 2 539c3 de b
! C DmDictionary 0 5398f 3 
! C DmString 1 539a1 36 b
! C DmSet 0 7d6e 1 
! C DmString 1 7d9c 5 Other 
! L 7d9c  
! c 1 539a0 a categories 
! c 1 53991 f DebugLibrary.pm 
! c 1 53990 4 name 
! C DmInteger 2 539a3 1 
! c 1 539a2 9 substMode  
! c 2 539f8 e1 b
! C DmDictionary 0 539c4 3 
! C DmString 1 539d6 36 b
! C DmSet 0 7dad 1 
! C DmString 1 7ddb 5 Other 
! L 7ddb  
! c 1 539d5 a categories 
! c 1 539c6 11 DefaultLibrary.pm 
! c 1 539c5 4 name 
! C DmInteger 2 539d8 1 
! c 1 539d7 9 substMode  
! c 2 53a2d de b
! C DmDictionary 0 539f9 3 
! C DmString 1 53a0b 36 b
! C DmSet 0 7dec 1 
! C DmString 1 7e1a 5 Other 
! L 7e1a  
! c 1 53a0a a categories 
! c 1 539fb f FormsLibrary.pm 
! c 1 539fa 4 name 
! C DmInteger 2 53a0d 1 
! c 1 53a0c 9 substMode  
! c 2 53a62 d9 b
! C DmDictionary 0 53a2e 3 
! C DmString 1 53a40 36 b
! C DmSet 0 7e2b 1 
! C DmString 1 7e59 5 Other 
! L 7e59  
! c 1 53a3f a categories 
! c 1 53a30 a Library.pm 
! c 1 53a2f 4 name 
! C DmInteger 2 53a42 1 
! c 1 53a41 9 substMode  
! c 2 53a97 e4 b
! C DmDictionary 0 53a63 3 
! C DmString 1 53a75 39 b
! C DmSet 0 5375d 1 
! C DmString 1 538d7 5 Other 
! L 538d7  
! c 1 53a74 a categories 
! c 1 53a65 11 StringsLibrary.pm 
! c 1 53a64 4 name 
! C DmInteger 2 53a77 1 
! c 1 53a76 9 substMode  
! c 2 53acc e3 b
! C DmDictionary 0 53a98 3 
! C DmString 1 53aaa 36 b
! C DmSet 0 7e6a 1 
! C DmString 1 7e98 5 Other 
! L 7e98  
! c 1 53aa9 a categories 
! c 1 53a9a 13 VariablesLibrary.pm 
! c 1 53a99 4 name 
! C DmInteger 2 53aac 1 
! c 1 53aab 9 substMode  
! c 2 53acd 5 files 
! c 2 538ea 94 xterm -ls -fn -*-lucidatypewriter-medium-r-normal-*-12-* -bg gray90 -T Program -geometry 80x10+0+0 -e "[set command with 'Project->Launch Command']" 
! c 2 538e9 6 launch 
! c 2 538e6 4 make 
! c 2 538e5 4 make 
! c 2 538e8 0  
! c 2 538e7 8 makeFile 
! c 5 538eb 0 
! c 2 538ed 7 modules 
! c 2 538e4 9 Libraries 
! c 2 538e3 4 name 
--- 1,281 ----
  b
! C DmDictionary 0 e053 8 
! c 0 e275 9 
! C Category 1 7aeb 
! c 0 e2b5 4 
! C DmString 2 e2bc 2 e3 
! c 2 e2bb a defaultExe 
! C DmSet 3 e2be 1 
! c 2 7afa 2 e3 
  L 7afa 
! c 2 e2bd b executables 
! c 3 e2b9 3 
! c 2 7b01 3 *.C 
! L 7b01 
! c 2 7b04 4 *.cc 
! L 7b04 
! c 2 7b07 5 *.cpp 
! L 7b07 
! c 2 e2b8 a extensions 
! c 2 e2b7 a CPP_source 
! c 2 e2b6 4 name 
! c 2 e277 a CPP_source 
! c 1 7b1c 
! c 0 e2fb 4 
! c 2 e302 2 e3 
! c 2 e301 a defaultExe 
! c 3 e304 1 
! c 2 7b29 2 e3 
! L 7b29 
! c 2 e303 b executables 
! c 3 e2ff 1 
! c 2 7b30 3 *.c 
! L 7b30 
! c 2 e2fe a extensions 
! c 2 e2fd 8 C_source 
! c 2 e2fc 4 name 
! c 2 e278 8 C_source 
! c 1 7b45 
! c 0 e335 4 
! c 2 e33c 2 e3 
! c 2 e33b a defaultExe 
! c 3 e33e 1 
! c 2 7b52 2 e3 
! L 7b52 
! c 2 e33d b executables 
! c 3 e339 1 
! c 2 7b59 3 *.e 
! L 7b59 
! c 2 e338 a extensions 
! c 2 e337 6 Eiffel 
! c 2 e336 4 name 
! c 2 e279 6 Eiffel 
! c 1 7b6e 
! c 0 e36f 4 
! c 2 e376 2 e3 
! c 2 e375 a defaultExe 
! c 3 e378 1 
! c 2 7b7b 2 e3 
  L 7b7b 
! c 2 e377 b executables 
! c 3 e373 4 
! c 2 7b82 3 *.F 
! L 7b82 
! c 2 7b85 3 *.f 
! L 7b85 
! c 2 7b88 5 *.for 
! L 7b88 
! c 2 7b8b 5 *.fpp 
! L 7b8b 
! c 2 e372 a extensions 
! c 2 e371 7 Fortran 
! c 2 e370 4 name 
! c 2 e27a 7 Fortran 
! c 1 7ba0 
! c 0 e3b5 4 
! c 2 e3bc 2 e3 
! c 2 e3bb a defaultExe 
! c 3 e3be 1 
! c 2 7bad 2 e3 
  L 7bad 
! c 2 e3bd b executables 
! c 3 e3b9 2 
! c 2 7bb4 3 *.H 
! L 7bb4 
! c 2 7bb7 3 *.h 
! L 7bb7 
! c 2 e3b8 a extensions 
! c 2 e3b7 6 Header 
! c 2 e3b6 4 name 
! c 2 e27b 6 Header 
! c 1 7bcc 
! c 0 e3f3 4 
! c 2 e3fa 9 surfboard 
! c 2 e3f9 a defaultExe 
! c 3 e3fc 2 
! c 2 7bd9 2 e3 
  L 7bd9 
! c 2 7bdc 9 surfboard 
  L 7bdc 
! c 2 e3fb b executables 
! c 3 e3f7 2 
! c 2 7be3 5 *.htm 
! L 7be3 
! c 2 7be6 6 *.html 
! L 7be6 
! c 2 e3f6 a extensions 
! c 2 e3f5 4 Html 
! c 2 e3f4 4 name 
! c 2 e27c 4 Html 
! c 1 7bfb 
! c 0 e435 4 
! c 2 e43c 2 e3 
! c 2 e43b a defaultExe 
! c 3 e43e 1 
! c 2 7c08 2 e3 
! L 7c08 
! c 2 e43d b executables 
! c 3 e439 1 
! c 2 7c0f 6 *.java 
! L 7c0f 
! c 2 e438 a extensions 
! c 2 e437 4 Java 
! c 2 e436 4 name 
! c 2 e27d 4 Java 
! c 1 7c24 
! c 0 e46f 4 
! c 2 e476 2 e3 
! c 2 e475 a defaultExe 
! c 3 e478 1 
! c 2 7c31 2 e3 
! L 7c31 
! c 2 e477 b executables 
! c 3 e473 1 
! c 2 7c38 5 *.tex 
! L 7c38 
! c 2 e472 a extensions 
! c 2 e471 5 Latex 
! c 2 e470 4 name 
! c 2 e27e 5 Latex 
! c 1 7c4d 
! c 0 e4a9 4 
! c 2 e4b0 2 e3 
! c 2 e4af a defaultExe 
! c 3 e4b2 1 
! c 2 7c5a 2 e3 
! L 7c5a 
! c 2 e4b1 b executables 
! c 3 e4ad 0 
! c 2 e4ac a extensions 
! c 2 e4ab 5 Other 
! c 2 e4aa 4 name 
! c 2 e27f 5 Other 
! c 2 e274 a categories 
! c 0 e281 1 
! C ProjectDir 4 7c77 
! c 2 7c78 28 netscript2/src/perl/NetScript/Libraries/ 11 81 
! c 2 7c79 0  0 
! c 2 e283 28 netscript2/src/perl/NetScript/Libraries/ 
! c 2 e280 b directories 
! C DmBag 5 e05f a 
! c 2 e095 d7 b
! C DmDictionary 0 e061 3 
! C DmString 1 e073 36 b
! C DmSet 0 7cbd 1 
! C DmString 1 7ceb 5 Other 
! L 7ceb  
! c 1 e072 a categories 
! c 1 e063 f ClassLibrary.pm 
! c 1 e062 4 name 
! C DmInteger 2 e075 1 
! c 1 e074 9 substMode  
! c 2 e0ca e4 b
! C DmDictionary 0 e096 3 
! C DmString 1 e0a8 36 b
! C DmSet 0 7cfc 1 
! C DmString 1 7d2a 5 Other 
! L 7d2a  
! c 1 e0a7 a categories 
! c 1 e098 1b ControlStructuresLibrary.pm 
! c 1 e097 4 name 
! C DmInteger 2 e0aa 1 
! c 1 e0a9 9 substMode  
! c 2 e0ff db b
! C DmDictionary 0 e0cb 3 
! C DmString 1 e0dd 36 b
! C DmSet 0 7d3b 1 
! C DmString 1 7d69 5 Other 
! L 7d69  
! c 1 e0dc a categories 
! c 1 e0cd 12 DatabaseLibrary.pm 
! c 1 e0cc 4 name 
! C DmInteger 2 e0df 1 
! c 1 e0de 9 substMode  
! c 2 e134 d7 b
! C DmDictionary 0 e100 3 
! C DmString 1 e112 36 b
! C DmSet 0 7d7a 1 
! C DmString 1 7da8 5 Other 
! L 7da8  
! c 1 e111 a categories 
! c 1 e102 f DebugLibrary.pm 
! c 1 e101 4 name 
! C DmInteger 2 e114 1 
! c 1 e113 9 substMode  
! c 2 e169 da b
! C DmDictionary 0 e135 3 
! C DmString 1 e147 36 b
! C DmSet 0 7db9 1 
! C DmString 1 7de7 5 Other 
! L 7de7  
! c 1 e146 a categories 
! c 1 e137 11 DefaultLibrary.pm 
! c 1 e136 4 name 
! C DmInteger 2 e149 1 
! c 1 e148 9 substMode  
! c 2 e19e d7 b
! C DmDictionary 0 e16a 3 
! C DmString 1 e17c 36 b
! C DmSet 0 dece 1 
! C DmString 1 e048 5 Other 
! L e048  
! c 1 e17b a categories 
! c 1 e16c f FilesLibrary.pm 
! c 1 e16b 4 name 
! C DmInteger 2 e17e 1 
! c 1 e17d 9 substMode  
! c 2 e1d3 d7 b
! C DmDictionary 0 e19f 3 
! C DmString 1 e1b1 36 b
! C DmSet 0 7df8 1 
! C DmString 1 7e26 5 Other 
! L 7e26  
! c 1 e1b0 a categories 
! c 1 e1a1 f FormsLibrary.pm 
! c 1 e1a0 4 name 
! C DmInteger 2 e1b3 1 
! c 1 e1b2 9 substMode  
! c 2 e208 d2 b
! C DmDictionary 0 e1d4 3 
! C DmString 1 e1e6 36 b
! C DmSet 0 7e37 1 
! C DmString 1 7e65 5 Other 
! L 7e65  
! c 1 e1e5 a categories 
! c 1 e1d6 a Library.pm 
! c 1 e1d5 4 name 
! C DmInteger 2 e1e8 1 
! c 1 e1e7 9 substMode  
! c 2 e23d da b
! C DmDictionary 0 e209 3 
! C DmString 1 e21b 36 b
! C DmSet 0 7e76 1 
! C DmString 1 7ea4 5 Other 
! L 7ea4  
! c 1 e21a a categories 
! c 1 e20b 11 StringsLibrary.pm 
! c 1 e20a 4 name 
! C DmInteger 2 e21d 1 
! c 1 e21c 9 substMode  
! c 2 e272 dc b
! C DmDictionary 0 e23e 3 
! C DmString 1 e250 36 b
! C DmSet 0 7eb5 1 
! C DmString 1 7ee3 5 Other 
! L 7ee3  
! c 1 e24f a categories 
! c 1 e240 13 VariablesLibrary.pm 
! c 1 e23f 4 name 
! C DmInteger 2 e252 1 
! c 1 e251 9 substMode  
! c 2 e273 5 files 
! c 2 e05b 94 xterm -ls -fn -*-lucidatypewriter-medium-r-normal-*-12-* -bg gray90 -T Program -geometry 80x10+0+0 -e "[set command with 'Project->Launch Command']" 
! c 2 e05a 6 launch 
! c 2 e057 4 make 
! c 2 e056 4 make 
! c 2 e059 0  
! c 2 e058 8 makeFile 
! c 5 e05c 0 
! c 2 e05e 7 modules 
! c 2 e055 9 Libraries 
! c 2 e054 4 name 

[NetScript CVS] CVS: netscript2/src/perl/NetScript/Libraries StringsLibrary.pm,NONE,1.1 ControlStructuresLibrary.pm,1.8,1.9 Library.pm,1.6,1.7 VariablesLibrary.pm,1.4,1.5

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

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

Modified Files:
	ControlStructuresLibrary.pm Library.pm VariablesLibrary.pm 
Added Files:
	StringsLibrary.pm 
Log Message:
* added string library
* fixed a bug in database library
* introduced variable info function in library base class to avoid doubled code

--- NEW FILE: StringsLibrary.pm ---
#--------------------------------------------------------
# $Id: StringsLibrary.pm,v 1.1 2002/08/14 22:23:35 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 string operations.
# To load this library put the following statements into the netscript:
# <pre>
#       &lt;?netscript use Strings?&gt;
# </pre>
# Add the following attribute to your document element:
# <pre>
#       &lt;yourdocumentelement xmlns:str=&quot;http://str.netscript.insomnia-hq.de&quot;/&gt;
# </pre>
# <pre>
#       &lt;ns:split string=&quot;{any string}&quot; delim=&quot;{a delimiter regexp}&quot;
#               var|name=&quot;var1 [var2 var3 ...]&quot;/&gt;
# <pre>
# Splits the given string using the given delimiter and puts the
# substrings into the given variables. If there is only one variable name
# given, the substrings will be put into an array with the given 
# variable name.
# <pre>
#       &lt;ns:replace string=&quot;{any string}&quot; search=&quot;{a regexp}&quot;
#           replace=&quot;{a string containg backreferences}&quot; var|name=&quot;var1&quot;/&gt;
# </pre>
# Searches for the given regexp in the given string, and replaces it 
# with the given replace string. The result is put into the given 
# variable.The replace string may contain backreferences &quot;\1&quot; to &quot;\9&quot;
# which will be replaced with parentheses-groups from the regexp. 
# Also this library provides the following functions for string processing:
#   <pre>
#       trim[ a string ] - trims all whitespace from the string's left and right end
#   </pre>
#
#*/
package NetScript::Libraries::StringsLibrary;
use base qw(NetScript::Libraries::Library);

use NetScript::Engine::EventListener;
use NetScript::Engine::EventRelay;
use NetScript::Interpreter;
use NetScript::Engine::DOMWalker;

use vars qw( $STR_NAMESPACE_URI );

$STR_NAMESPACE_URI="http://str.netscript.insomnia-hq.de";

#/**
# 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 );
    # 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 );
    
    # register the trim function
    my $se = $this -> interpreter() -> getStatementEvaluator();
    $se -> registerLibraryFunction( "trim", $this, "doTrim" );
    }

#/**
# Called upon element start
# @callback
#*/
sub elementStarted {
    my ( $this, $event ) = @_;
    my $domWalker = $event -> getEventUnknown();
    my $node = $domWalker -> currentSource();
    if ( $node -> getNamespaceURI() eq $STR_NAMESPACE_URI ) {
        my $name = $node -> getLocalName();
        if ($name eq "replace") {
            $this -> doReplace( $node, $domWalker );
            0; # consume event
            }
        elsif ( $name eq "split" ) {
            $this -> doSplit( $node, $domWalker );
            0;
            }
        else {
            1; # do not consume event
            }
        }
    else {
        1; # do not consume event
        }
    }

#/**
# Splits the given String and puts the result into the
# variables.
# @param an instance of XML::DOM2::Element
# @param an instance of NetScript::Engine::DOMWalker
#*/
sub doSplit {
    my ( $this, $node, $domWalker ) = @_;
    my $se = $this -> interpreter() -> getStatementEvaluator();
    my $string = $se -> evaluateStatement( $node -> getAttribute( "string" ) );
    my $delim = $se -> evaluateStatement( $node -> getAttribute( "delim" ) );
    
    my ( $createVar, $varName ) = $this -> getVariableInfo( $node );

    my @subStrings = split( $delim, $string );
    my @vars = split( / /, $varName );
    # if there is more than one variable name specified
    if ( scalar(@vars) > 1 ) {
        for ( @vars ) {
            if ( $createVar ) {
                $se -> createVariable( $_, shift @subStrings );
                }
            else {
                $se -> setVariable( $_, shift @subStrings );
                }
            }
        }
    # only one variable name, so fill an array
    else {
        my $idx = 0;
        for ( @subStrings ) {
            if ( $createVar ) {
                # create the First Index
                $se -> createVariable( $varName.":".$idx, $_ );
                # set the remaining ones
                $createVar = 0;
                }
            else {
                $se -> setVariable( $varName.":".$idx, $_ );
                }
            $idx ++;
            }
        }
    $domWalker -> stepSourceNext();
    }

#/**
# Does the search and replace on the given string.
# @param an instance of XML::DOM2::Element
# @param an instance of NetScript::Engine::DOMWalker
#*/
sub doReplace {
    my ( $this, $node, $domWalker ) = @_;
    my $se = $this -> interpreter() -> getStatementEvaluator();
    my $string = $se -> evaluateStatement( $node -> getAttribute( "string" ) );
    my $search = $se -> evaluateStatement( $node -> getAttribute( "search" ) );
    my $replace = $se -> evaluateStatement( $node -> getAttribute( "replace" ) );
    
    my ($createVar, $varName) = $this -> getVariableInfo( $node );
    $string =~ s/$search/$replace/eg;
    my @brefs = ($1, $2, $3, $4, $5, $6, $7, $8, $9);
    for ( 1..9 ) {
        last unless $string =~ /\\[$_-9]/; # break if there is nothing to replace
        $string =~ s/\\$_/$brefs[$_ - 1]/eg;        
        }

    if ( $createVar ) {
        $se -> createVariable( $varName, $string );
        }
    else {
        $se -> setVariable( $varName, $string );
        }
    $domWalker -> stepSourceNext();
    }

#/**
# Removes all whitespace from the left and right side
# of the string and returns the string.
# @callback Called by StatementEvaluator
#*/
sub doTrim {
    my ( $this, $string, $se, $int ) = @_;
    $string =~ s/^\s*(.*?)\s*$/$1/;
    return $string;
    }
#/**
# Called upon element finish.
# @callback
#*/
sub elementFinished {
    my ( $this, $event ) = @_;
    my $domWalker = $event -> getEventUnknown();
    my $node = $domWalker -> currentSource();
    if ( $node -> getNamespaceURI() eq $STR_NAMESPACE_URI ) {
        my $name = $node -> getLocalName();
        if ($name eq "split"  || $name eq "replace") {
            0; # consume event 
            }
        else {
            1; # do not consume
            }
        }
    else {
        1; # do not consume event
        }
    }




sub shutdown {
    my ($this) = @_;
    $this -> SUPER::shutdown();
    }

sub getName {
    "Strings Library";
    }

sub getVersion {
    1.0;
    }

sub getDescription {
    "This Library provides string functions.";
    }
1; #make require happy


Index: ControlStructuresLibrary.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/ControlStructuresLibrary.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** ControlStructuresLibrary.pm	7 Aug 2002 20:13:55 -0000	1.8
--- ControlStructuresLibrary.pm	14 Aug 2002 22:23:35 -0000	1.9
***************
*** 207,213 ****
      # replace variables
      my $se = $this -> interpreter() -> getStatementEvaluator();
- warn "EVAL: $test";
      $test = $se -> evaluateStatement( $test );
- warn "EVAL: $test";
      eval( $test );
      }
--- 207,211 ----
***************
*** 220,224 ****
  #*/
  sub ifStart {
- warn "IF !!!!!!\n"    ;
      my ( $this, $domWalker, $node ) = @_;
      # check condition
--- 218,221 ----
***************
*** 231,235 ****
      else {
          # condition is true, proceed as usual
- warn "TEST SUCCESS!" ;
          $this -> interpreter() -> newState();
          $domWalker -> stepSourceIn();
--- 228,231 ----

Index: Library.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/Library.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** Library.pm	11 Jul 2002 22:03:10 -0000	1.6
--- Library.pm	14 Aug 2002 22:23:35 -0000	1.7
***************
*** 61,64 ****
--- 61,112 ----
  
  #/**
+ # Checks the given node for "var" and "name" attributes and
+ # returns the name of the variable as wells as information 
+ # if the variable exists or must be created.
+ # Returns an array holding two entries. The first one
+ # is 1 if the variable has to be created 0 otherwise.
+ # The second one contains the variable name.
+ # @param an instance of XML::DOM2::Element
+ # @return 1 if the variable must be created, false otherwise
+ # @return the name of the variable.
+ # @note Use like this:
+ #   <pre> 
+ #       my ($create, $name) = $this -> getVariableInfo( $element );
+ #   </pre>
+ # Throws fatal even if both name and var are specified or
+ # both are unspecified.
+ #*/
+ sub getVariableInfo {
+     my ( $this, $element )  = @_;
+     my $name = $element -> getAttribute( "name" );
+     my $var = $element -> getAttribute( "var" );
+     
+     my $se = $this -> interpreter() -> getStatementEvaluator();
+     
+     $name = $se -> evaluateStatement( $name );
+     $var = $se -> evaluateStatement( $var );
+     
+     if ( $name ne "" && $var eq "" ) {
+         return ( 1, $name );
+         }
+     elsif ( $name eq "" && $var ne "" ) {
+         return ( 0, $var );
+         }
+     elsif ( $name eq "" && $var eq "" ) {
+         $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
+                 $NetScript::Interpreter::FATAL_EVENT, 
+                 "Neither the \"var\" nor the \"name\" attribute is specified. You must specify one of them." );
+         return;        
+         }
+     else {
+         $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
+                 $NetScript::Interpreter::FATAL_EVENT, 
+                 "Both the \"var\" and the \"name\" attribute are specified. You must specify only one of them." );
+         return;        
+         }
+     }
+ 
+ 
+ #/**
  # Returns an instance of <code>NetScript::Interpreter</code>
  # @public

Index: VariablesLibrary.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/VariablesLibrary.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** VariablesLibrary.pm	11 Jul 2002 22:03:10 -0000	1.4
--- VariablesLibrary.pm	14 Aug 2002 22:23:35 -0000	1.5
***************
*** 109,118 ****
  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");
      my $rvalue = $node -> getAttribute( "rval" );
--- 109,114 ----
  sub varStart {
      my ( $this, $domWalker, $node ) = @_;
      my $se = $this -> interpreter() -> getStatementEvaluator();
!     my ( $createVar, $varName ) = $this -> getVariableInfo( $node );
      my $value = $node -> getAttribute( "val");
      my $rvalue = $node -> getAttribute( "rval" );
***************
*** 120,128 ****
      if ( $rvalue eq "" && defined( $value ) ) {
          $value = $se -> evaluateStatement( $value );
!         if ( $name ne "" && $var eq "" ) {
!             $se -> createVariable( $name, $value );
              }
!         elsif( $name eq "" && $var ne "" ) {
!             $se -> setVariable( $var, $value );
              }
          }
--- 116,124 ----
      if ( $rvalue eq "" && defined( $value ) ) {
          $value = $se -> evaluateStatement( $value );
!         if ( $createVar ) {
!             $se -> createVariable( $varName, $value );
              }
!         else {
!             $se -> setVariable( $varName, $value );
              }
          }
***************
*** 130,140 ****
          $rvalue = $se -> evaluateStatement( $rvalue );
          my $reference = $se -> resolveObject( $rvalue );
!         if ( $name ne "" && $var eq "" ) {
              $this -> interpreter() -> getState() ->
!                 createVariableValue( $name, $reference );
              }
!         elsif( $name eq "" && $var ne "" ) {
              $this -> interpreter() -> getState() ->
!                 setVariableValue( $name, $reference );
              }
          }
--- 126,136 ----
          $rvalue = $se -> evaluateStatement( $rvalue );
          my $reference = $se -> resolveObject( $rvalue );
!         if ( $createVar ) {
              $this -> interpreter() -> getState() ->
!                 createVariableValue( $varName, $reference );
              }
!         else {
              $this -> interpreter() -> getState() ->
!                 setVariableValue( $varName, $reference );
              }
          }

[NetScript CVS] CVS: netscript2/src/perl/NetScript/Libraries wipeout.project,1.6,1.7

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

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

Modified Files:
	wipeout.project 
Log Message:
* added string library
* fixed a bug in database library
* introduced variable info function in library base class to avoid doubled code

Index: wipeout.project
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/wipeout.project,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** wipeout.project	11 Jul 2002 22:03:10 -0000	1.6
--- wipeout.project	14 Aug 2002 22:23:25 -0000	1.7
***************
*** 1,248 ****
  b
! C DmDictionary 0 d787 8 
! c 0 d90a 9 
! C Category 1 702b 
! c 0 d94a 4 
! C DmString 2 d951 2 e3 
! c 2 d950 a defaultExe 
! C DmSet 3 d953 1 
! c 2 703a 2 e3 
! L 703a 
! c 2 d952 b executables 
! c 3 d94e 3 
! c 2 7041 3 *.C 
! L 7041 
! c 2 7044 4 *.cc 
! L 7044 
! c 2 7047 5 *.cpp 
! L 7047 
! c 2 d94d a extensions 
! c 2 d94c a CPP_source 
! c 2 d94b 4 name 
! c 2 d90c a CPP_source 
! c 1 705c 
! c 0 d990 4 
! c 2 d997 2 e3 
! c 2 d996 a defaultExe 
! c 3 d999 1 
! c 2 7069 2 e3 
! L 7069 
! c 2 d998 b executables 
! c 3 d994 1 
! c 2 7070 3 *.c 
! L 7070 
! c 2 d993 a extensions 
! c 2 d992 8 C_source 
! c 2 d991 4 name 
! c 2 d90d 8 C_source 
! c 1 7085 
! c 0 d9ca 4 
! c 2 d9d1 2 e3 
! c 2 d9d0 a defaultExe 
! c 3 d9d3 1 
! c 2 7092 2 e3 
! L 7092 
! c 2 d9d2 b executables 
! c 3 d9ce 1 
! c 2 7099 3 *.e 
! L 7099 
! c 2 d9cd a extensions 
! c 2 d9cc 6 Eiffel 
! c 2 d9cb 4 name 
! c 2 d90e 6 Eiffel 
! c 1 70ae 
! c 0 da04 4 
! c 2 da0b 2 e3 
! c 2 da0a a defaultExe 
! c 3 da0d 1 
! c 2 70bb 2 e3 
! L 70bb 
! c 2 da0c b executables 
! c 3 da08 4 
! c 2 70c2 3 *.F 
! L 70c2 
! c 2 70c5 3 *.f 
! L 70c5 
! c 2 70c8 5 *.for 
! L 70c8 
! c 2 70cb 5 *.fpp 
! L 70cb 
! c 2 da07 a extensions 
! c 2 da06 7 Fortran 
! c 2 da05 4 name 
! c 2 d90f 7 Fortran 
! c 1 70e0 
! c 0 da4a 4 
! c 2 da51 2 e3 
! c 2 da50 a defaultExe 
! c 3 da53 1 
! c 2 70ed 2 e3 
! L 70ed 
! c 2 da52 b executables 
! c 3 da4e 2 
! c 2 70f4 3 *.H 
! L 70f4 
! c 2 70f7 3 *.h 
! L 70f7 
! c 2 da4d a extensions 
! c 2 da4c 6 Header 
! c 2 da4b 4 name 
! c 2 d910 6 Header 
! c 1 710c 
! c 0 da88 4 
! c 2 da8f 9 surfboard 
! c 2 da8e a defaultExe 
! c 3 da91 2 
! c 2 7119 2 e3 
! L 7119 
! c 2 711c 9 surfboard 
! L 711c 
! c 2 da90 b executables 
! c 3 da8c 2 
! c 2 7123 5 *.htm 
! L 7123 
! c 2 7126 6 *.html 
! L 7126 
! c 2 da8b a extensions 
! c 2 da8a 4 Html 
! c 2 da89 4 name 
! c 2 d911 4 Html 
! c 1 713b 
! c 0 daca 4 
! c 2 dad1 2 e3 
! c 2 dad0 a defaultExe 
! c 3 dad3 1 
! c 2 7148 2 e3 
! L 7148 
! c 2 dad2 b executables 
! c 3 dace 1 
! c 2 714f 6 *.java 
! L 714f 
! c 2 dacd a extensions 
! c 2 dacc 4 Java 
! c 2 dacb 4 name 
! c 2 d912 4 Java 
! c 1 7164 
! c 0 db04 4 
! c 2 db0b 2 e3 
! c 2 db0a a defaultExe 
! c 3 db0d 1 
! c 2 7171 2 e3 
! L 7171 
! c 2 db0c b executables 
! c 3 db08 1 
! c 2 7178 5 *.tex 
! L 7178 
! c 2 db07 a extensions 
! c 2 db06 5 Latex 
! c 2 db05 4 name 
! c 2 d913 5 Latex 
! c 1 718d 
! c 0 db3e 4 
! c 2 db45 2 e3 
! c 2 db44 a defaultExe 
! c 3 db47 1 
! c 2 719a 2 e3 
! L 719a 
! c 2 db46 b executables 
! c 3 db42 0 
! c 2 db41 a extensions 
! c 2 db40 5 Other 
! c 2 db3f 4 name 
! c 2 d914 5 Other 
! c 2 d909 a categories 
! c 0 d916 1 
! C ProjectDir 4 71b7 
! c 2 71b8 28 netscript2/src/perl/NetScript/Libraries/ 11 81 
! c 2 71b9 0  0 
! c 2 d918 28 netscript2/src/perl/NetScript/Libraries/ 
! c 2 d915 b directories 
! C DmBag 5 d793 7 
! c 2 d7c9 d7 b
! C DmDictionary 0 d795 3 
! C DmString 1 d7a7 36 b
! C DmSet 0 d602 1 
! C DmString 1 d77c 5 Other 
! L d77c  
! c 1 d7a6 a categories 
! c 1 d797 f ClassLibrary.pm 
! c 1 d796 4 name 
! C DmInteger 2 d7a9 1 
! c 1 d7a8 9 substMode  
! c 2 d7fe e4 b
! C DmDictionary 0 d7ca 3 
! C DmString 1 d7dc 36 b
! C DmSet 0 71f7 1 
! C DmString 1 7225 5 Other 
! L 7225  
! c 1 d7db a categories 
! c 1 d7cc 1b ControlStructuresLibrary.pm 
! c 1 d7cb 4 name 
! C DmInteger 2 d7de 1 
! c 1 d7dd 9 substMode  
! c 2 d833 d7 b
! C DmDictionary 0 d7ff 3 
! C DmString 1 d811 36 b
! C DmSet 0 7236 1 
! C DmString 1 7264 5 Other 
! L 7264  
! c 1 d810 a categories 
! c 1 d801 f DebugLibrary.pm 
! c 1 d800 4 name 
! C DmInteger 2 d813 1 
! c 1 d812 9 substMode  
! c 2 d868 da b
! C DmDictionary 0 d834 3 
! C DmString 1 d846 36 b
! C DmSet 0 7275 1 
! C DmString 1 72a3 5 Other 
! L 72a3  
! c 1 d845 a categories 
! c 1 d836 11 DefaultLibrary.pm 
! c 1 d835 4 name 
! C DmInteger 2 d848 1 
! c 1 d847 9 substMode  
! c 2 d89d d7 b
! C DmDictionary 0 d869 3 
! C DmString 1 d87b 36 b
! C DmSet 0 72b4 1 
! C DmString 1 72e2 5 Other 
! L 72e2  
! c 1 d87a a categories 
! c 1 d86b f FormsLibrary.pm 
! c 1 d86a 4 name 
! C DmInteger 2 d87d 1 
! c 1 d87c 9 substMode  
! c 2 d8d2 d2 b
! C DmDictionary 0 d89e 3 
! C DmString 1 d8b0 36 b
! C DmSet 0 72f3 1 
! C DmString 1 7321 5 Other 
! L 7321  
! c 1 d8af a categories 
! c 1 d8a0 a Library.pm 
! c 1 d89f 4 name 
! C DmInteger 2 d8b2 1 
! c 1 d8b1 9 substMode  
! c 2 d907 dc b
! C DmDictionary 0 d8d3 3 
! C DmString 1 d8e5 36 b
! C DmSet 0 7332 1 
! C DmString 1 7360 5 Other 
! L 7360  
! c 1 d8e4 a categories 
! c 1 d8d5 13 VariablesLibrary.pm 
! c 1 d8d4 4 name 
! C DmInteger 2 d8e7 1 
! c 1 d8e6 9 substMode  
! c 2 d908 5 files 
! c 2 d78f 94 xterm -ls -fn -*-lucidatypewriter-medium-r-normal-*-12-* -bg gray90 -T Program -geometry 80x10+0+0 -e "[set command with 'Project->Launch Command']" 
! c 2 d78e 6 launch 
! c 2 d78b 4 make 
! c 2 d78a 4 make 
! c 2 d78d 0  
! c 2 d78c 8 makeFile 
! c 5 d790 0 
! c 2 d792 7 modules 
! c 2 d789 9 Libraries 
! c 2 d788 4 name 
--- 1,270 ----
  b
! C DmDictionary 0 538e2 8 
! c 0 53acf 9 
! C Category 1 7ae1 
! c 0 53b0f 4 
! C DmString 2 53b16 2 e3 
! c 2 53b15 a defaultExe 
! C DmSet 3 53b18 1 
! c 2 7af0 2 e3 
! L 7af0 
! c 2 53b17 b executables 
! c 3 53b13 3 
! c 2 7af7 3 *.C 
! L 7af7 
! c 2 7afa 4 *.cc 
! L 7afa 
! c 2 7afd 5 *.cpp 
! L 7afd 
! c 2 53b12 a extensions 
! c 2 53b11 a CPP_source 
! c 2 53b10 4 name 
! c 2 53ad1 a CPP_source 
! c 1 7b12 
! c 0 53b55 4 
! c 2 53b5c 2 e3 
! c 2 53b5b a defaultExe 
! c 3 53b5e 1 
! c 2 7b1f 2 e3 
! L 7b1f 
! c 2 53b5d b executables 
! c 3 53b59 1 
! c 2 7b26 3 *.c 
! L 7b26 
! c 2 53b58 a extensions 
! c 2 53b57 8 C_source 
! c 2 53b56 4 name 
! c 2 53ad2 8 C_source 
! c 1 7b3b 
! c 0 53b8f 4 
! c 2 53b96 2 e3 
! c 2 53b95 a defaultExe 
! c 3 53b98 1 
! c 2 7b48 2 e3 
! L 7b48 
! c 2 53b97 b executables 
! c 3 53b93 1 
! c 2 7b4f 3 *.e 
! L 7b4f 
! c 2 53b92 a extensions 
! c 2 53b91 6 Eiffel 
! c 2 53b90 4 name 
! c 2 53ad3 6 Eiffel 
! c 1 7b64 
! c 0 53bc9 4 
! c 2 53bd0 2 e3 
! c 2 53bcf a defaultExe 
! c 3 53bd2 1 
! c 2 7b71 2 e3 
! L 7b71 
! c 2 53bd1 b executables 
! c 3 53bcd 4 
! c 2 7b78 3 *.F 
! L 7b78 
! c 2 7b7b 3 *.f 
! L 7b7b 
! c 2 7b7e 5 *.for 
! L 7b7e 
! c 2 7b81 5 *.fpp 
! L 7b81 
! c 2 53bcc a extensions 
! c 2 53bcb 7 Fortran 
! c 2 53bca 4 name 
! c 2 53ad4 7 Fortran 
! c 1 7b96 
! c 0 53c0f 4 
! c 2 53c16 2 e3 
! c 2 53c15 a defaultExe 
! c 3 53c18 1 
! c 2 7ba3 2 e3 
! L 7ba3 
! c 2 53c17 b executables 
! c 3 53c13 2 
! c 2 7baa 3 *.H 
! L 7baa 
! c 2 7bad 3 *.h 
! L 7bad 
! c 2 53c12 a extensions 
! c 2 53c11 6 Header 
! c 2 53c10 4 name 
! c 2 53ad5 6 Header 
! c 1 7bc2 
! c 0 53c4d 4 
! c 2 53c54 9 surfboard 
! c 2 53c53 a defaultExe 
! c 3 53c56 2 
! c 2 7bcf 2 e3 
! L 7bcf 
! c 2 7bd2 9 surfboard 
! L 7bd2 
! c 2 53c55 b executables 
! c 3 53c51 2 
! c 2 7bd9 5 *.htm 
! L 7bd9 
! c 2 7bdc 6 *.html 
! L 7bdc 
! c 2 53c50 a extensions 
! c 2 53c4f 4 Html 
! c 2 53c4e 4 name 
! c 2 53ad6 4 Html 
! c 1 7bf1 
! c 0 53c8f 4 
! c 2 53c96 2 e3 
! c 2 53c95 a defaultExe 
! c 3 53c98 1 
! c 2 7bfe 2 e3 
! L 7bfe 
! c 2 53c97 b executables 
! c 3 53c93 1 
! c 2 7c05 6 *.java 
! L 7c05 
! c 2 53c92 a extensions 
! c 2 53c91 4 Java 
! c 2 53c90 4 name 
! c 2 53ad7 4 Java 
! c 1 7c1a 
! c 0 53cc9 4 
! c 2 53cd0 2 e3 
! c 2 53ccf a defaultExe 
! c 3 53cd2 1 
! c 2 7c27 2 e3 
! L 7c27 
! c 2 53cd1 b executables 
! c 3 53ccd 1 
! c 2 7c2e 5 *.tex 
! L 7c2e 
! c 2 53ccc a extensions 
! c 2 53ccb 5 Latex 
! c 2 53cca 4 name 
! c 2 53ad8 5 Latex 
! c 1 7c43 
! c 0 53d03 4 
! c 2 53d0a 2 e3 
! c 2 53d09 a defaultExe 
! c 3 53d0c 1 
! c 2 7c50 2 e3 
! L 7c50 
! c 2 53d0b b executables 
! c 3 53d07 0 
! c 2 53d06 a extensions 
! c 2 53d05 5 Other 
! c 2 53d04 4 name 
! c 2 53ad9 5 Other 
! c 2 53ace a categories 
! c 0 53adb 1 
! C ProjectDir 4 7c6d 
! c 2 7c6e 28 netscript2/src/perl/NetScript/Libraries/ 11 81 
! c 2 7c6f 0  0 
! c 2 53add 28 netscript2/src/perl/NetScript/Libraries/ 
! c 2 53ada b directories 
! C DmBag 5 538ee 9 
! c 2 53924 de b
! C DmDictionary 0 538f0 3 
! C DmString 1 53902 36 b
! C DmSet 0 7cb1 1 
! C DmString 1 7cdf 5 Other 
! L 7cdf  
! c 1 53901 a categories 
! c 1 538f2 f ClassLibrary.pm 
! c 1 538f1 4 name 
! C DmInteger 2 53904 1 
! c 1 53903 9 substMode  
! c 2 53959 eb b
! C DmDictionary 0 53925 3 
! C DmString 1 53937 36 b
! C DmSet 0 7cf0 1 
! C DmString 1 7d1e 5 Other 
! L 7d1e  
! c 1 53936 a categories 
! c 1 53927 1b ControlStructuresLibrary.pm 
! c 1 53926 4 name 
! C DmInteger 2 53939 1 
! c 1 53938 9 substMode  
! c 2 5398e e2 b
! C DmDictionary 0 5395a 3 
! C DmString 1 5396c 36 b
! C DmSet 0 7d2f 1 
! C DmString 1 7d5d 5 Other 
! L 7d5d  
! c 1 5396b a categories 
! c 1 5395c 12 DatabaseLibrary.pm 
! c 1 5395b 4 name 
! C DmInteger 2 5396e 1 
! c 1 5396d 9 substMode  
! c 2 539c3 de b
! C DmDictionary 0 5398f 3 
! C DmString 1 539a1 36 b
! C DmSet 0 7d6e 1 
! C DmString 1 7d9c 5 Other 
! L 7d9c  
! c 1 539a0 a categories 
! c 1 53991 f DebugLibrary.pm 
! c 1 53990 4 name 
! C DmInteger 2 539a3 1 
! c 1 539a2 9 substMode  
! c 2 539f8 e1 b
! C DmDictionary 0 539c4 3 
! C DmString 1 539d6 36 b
! C DmSet 0 7dad 1 
! C DmString 1 7ddb 5 Other 
! L 7ddb  
! c 1 539d5 a categories 
! c 1 539c6 11 DefaultLibrary.pm 
! c 1 539c5 4 name 
! C DmInteger 2 539d8 1 
! c 1 539d7 9 substMode  
! c 2 53a2d de b
! C DmDictionary 0 539f9 3 
! C DmString 1 53a0b 36 b
! C DmSet 0 7dec 1 
! C DmString 1 7e1a 5 Other 
! L 7e1a  
! c 1 53a0a a categories 
! c 1 539fb f FormsLibrary.pm 
! c 1 539fa 4 name 
! C DmInteger 2 53a0d 1 
! c 1 53a0c 9 substMode  
! c 2 53a62 d9 b
! C DmDictionary 0 53a2e 3 
! C DmString 1 53a40 36 b
! C DmSet 0 7e2b 1 
! C DmString 1 7e59 5 Other 
! L 7e59  
! c 1 53a3f a categories 
! c 1 53a30 a Library.pm 
! c 1 53a2f 4 name 
! C DmInteger 2 53a42 1 
! c 1 53a41 9 substMode  
! c 2 53a97 e4 b
! C DmDictionary 0 53a63 3 
! C DmString 1 53a75 39 b
! C DmSet 0 5375d 1 
! C DmString 1 538d7 5 Other 
! L 538d7  
! c 1 53a74 a categories 
! c 1 53a65 11 StringsLibrary.pm 
! c 1 53a64 4 name 
! C DmInteger 2 53a77 1 
! c 1 53a76 9 substMode  
! c 2 53acc e3 b
! C DmDictionary 0 53a98 3 
! C DmString 1 53aaa 36 b
! C DmSet 0 7e6a 1 
! C DmString 1 7e98 5 Other 
! L 7e98  
! c 1 53aa9 a categories 
! c 1 53a9a 13 VariablesLibrary.pm 
! c 1 53a99 4 name 
! C DmInteger 2 53aac 1 
! c 1 53aab 9 substMode  
! c 2 53acd 5 files 
! c 2 538ea 94 xterm -ls -fn -*-lucidatypewriter-medium-r-normal-*-12-* -bg gray90 -T Program -geometry 80x10+0+0 -e "[set command with 'Project->Launch Command']" 
! c 2 538e9 6 launch 
! c 2 538e6 4 make 
! c 2 538e5 4 make 
! c 2 538e8 0  
! c 2 538e7 8 makeFile 
! c 5 538eb 0 
! c 2 538ed 7 modules 
! c 2 538e4 9 Libraries 
! c 2 538e3 4 name 

[NetScript CVS] CVS: netscript2/src/perl/NetScript/Libraries DatabaseLibrary.pm,NONE,1.1 ClassLibrary.pm,1.2,1.3 ControlStructuresLibrary.pm,1.7,1.8

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

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

Modified Files:
	ClassLibrary.pm ControlStructuresLibrary.pm 
Added Files:
	DatabaseLibrary.pm 
Log Message:
* added database library


--- NEW FILE: DatabaseLibrary.pm ---
#--------------------------------------------------------
# $Id: DatabaseLibrary.pm,v 1.1 2002/08/07 20:13:55 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;

#/**
# The database library provides access to relational databases.
# To use the library in your scripts you must insert the following
# import statement to your Script file:
# <pre>
#   &lt;?netscript use Database?&gt;
# </pre>
# All database statement have to be in a separate namespace, so add
# the following attribute to your document element:
# <pre>
#   &lt;yourdocumentelement xmlns:db=&quot;http://db.netscript.insomnia-hq.de&quot;/&gt;
# </pre>
# To use the database, you must first specify some parameters for the database.
# <pre>
#   &lt;db:settings
#           name=&quot;MyDBSettings&quot;
#           host=&quot;host.to.your.db&quot;
#           database=&quot;database-name&quot;
#           type=&quot;mysql|Pg|Oracle|...&quot;
#           username=&quot;username&quot;
#           password=&quot;password&quot;/&gt;
# </pre>
# The database library has two modes of accessing the database.
# The first one is sending SQL directly to the database and 
# getting a resultset. This is done in the following way:
# <pre>
#   &lt;db:exec db=&quot;MyDBSettings&quot; 
#       query=&quot;{SQL-QUERY HERE}&quot; [{name|var}=&quot;{Variable here}&quot];/&gt;
# </pre>
# This will put a result set object into the given variable. The
# netscript declaration of a result set object is as follows:
# <pre>
#   &lt;ns:class&gt; 
#       &lt;!-- Is set to 1 if the last "nextLine"-operation successfully fetched
#           another line and set to 0 otherwise(no more lines available) --&gt;
#       &lt;ns:member name=&quot;lineFetched&quot;/&gt;
#       &lt;!-- Holds the current line number in the result set --&gt;
#       &lt;ns:member name=&quot;currentLine&quot;/&gt;
#       &lt;!-- An array holding the headings of the selected table --&gt;
#       &lt;ns:member name=&quot;headings&quot;/&gt;
#       &lt;!-- An array holding the content of the current line --&gt;
#       &lt;ns:member name=&quot;content&quot;/&gt;
#       &lt;!-- Reads the next line from the result set --&gt;
#       &lt;ns:method name=&quot;nextLine&quot;/&gt;
#   &lt;/ns:class&gt;
# </pre>  
# An example:
#   <pre>
#       &lt;example&gt;
#           &lt;db:settings name=&quot;myDB&quot;
#                   host=&quot;my.db.com&quot;
#                   port=&quot;6666&quot;
#                   database=&quot;KorksDB&quot;
#                   type=&quot;MySQL&quot;
#                   user=&quot;kork&quot;
#                   pass=&quot;mysecretpassword&quot;/&gt;
#           &lt;!-- Select all cars --&gt;
#           &lt;db:exec db=&quot;myDB&quot; query=&quot;SELECT * FROM Car&quot; name=&quot;allCars&quot;/&gt;
#           &lt;ns:var name=&quot;numCars&quot; val=&quot;0&quot;/&gt;
#           &lt;ns:invoke var=&quot;allCars&quot; method=&quot;getRemainingLines&quot; value=&quot;numCars&quot;/&gt;
#           &lt;ns:while test=&quot;$(numCars) &amp;gt; 0&quot;&gt;
#               &lt;ns:var name=&quot;aLine:!&quot;/&gt;
#               &lt;ns:invoke var=&quot;allCars&quot; method=&quot;fetchLine&quot; value=&quot;aLine&quot; escape=&quot;yes&quot;/&gt;
#               &lt;ns:for name=&quot;i&quot; from=&quot;0&quot; to=&quot;$(eval[@[aLine]-1])&quot;&gt;
#                   $(aLine:$(i))
#               &lt;/ns:for&gt;
#               &lt;ns:invoke var=&quot;allCars&quot; method=&quot;getRemainingLines&quot; value=&quot;numCars&quot;
#           &lt;/ns:while&gt;
#      &lt;/example&gt;     
#   </pre>
#               
# @note The database Library requires the DBI-Module.
#*/
package NetScript::Libraries::DatabaseLibrary;
use base qw(NetScript::Libraries::Library);


use NetScript::Engine::EventListener;
use NetScript::Engine::EventRelay;
use NetScript::Engine::Class;
use NetScript::Engine::Function;
use NetScript::Engine::Member;
use NetScript::Interpreter;
use NetScript::Engine::DOMWalker;
use DBI;

use vars qw( $DB_NAMESPACE_URI );

$DB_NAMESPACE_URI="http://db.netscript.insomnia-hq.de";

#/**
# Ctor. 
# @public
#*/
sub new {
    my $proto = shift;                  # get Prototype
    my $class = ref($proto) || $proto;
    my $this = $class -> SUPER::new();
    my %dbSettings = ();
    $this -> { m_dbSettings } = \%dbSettings;
    $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 );
    }

#/**
# Processes the db:settings-tag.
# @param an instance of NetScript::Engine::DOMWalker
# @param an instance of XML::DOM2::Element ( the db:settings-node )
#*/
sub processSettings {
    my ( $this, $domWalker, $node ) = @_;
    my %settings = ();
    $settings{ "host" } = $node -> getAttribute( "host" );
    $settings{ "port" } = $node -> getAttribute( "port" );
    $settings{ "type" } = $node -> getAttribute( "type" );
    $settings{ "username" } = $node -> getAttribute( "username" );
    $settings{ "password" } = $node -> getAttribute( "password" );
    $settings{ "database" } = $node -> getAttribute( "database" );
    my $name = $node -> getAttribute( "name" );
    unless( defined( $name ) ) {
        $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                $NetScript::Interpreter::FATAL_EVENT, 
                "You must specify a name for your DB-Settings." );
        return;                
        }
    $this -> { m_dbSettings } -> { $name } = \%settings;
    $domWalker -> stepSourceNext();
    }

#/**
# Runs the SQL statement.
# @param an instance of NetScript::Engine::DOMWalker
# @param an instance of XML::DOM2::Element ( the db:exec-node )
#*/
sub runStatement {
    my ( $this, $domWalker, $node )  = @_;
    my $dbName = $node -> getAttribute( "db" );
    if ( $dbName eq "" ) {
        $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                $NetScript::Interpreter::FATAL_EVENT, 
                "You must specify the \"db\"-attribute!" );
        return;
        }

    my $settings = $this -> { m_dbSettings } -> { $dbName };
    unless( defined( $settings ) ) {
        $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                $NetScript::Interpreter::FATAL_EVENT, 
                "There are no database settings named \"$dbName\"." );
        return;
        }    
        
    my $dbHandle = $settings -> { "handle" };
    # creating the database connection is lazy, we
    # do this on the first execute-statement.
    unless( defined( $dbHandle ) ) {
        my $type = $settings -> { "type" };
        my $host = $settings -> { "host" };
        my $port = $settings -> { "port" };
        my $database = $settings -> { "database" };
        my $username = $settings -> { "username" };
        my $password = $settings -> { "password" };
        eval {
            $dbHandle = DBI -> connect( "DBI:$type:dbname=$database;host=$host",
            $username, $password, {RaiseError => 0, AutoCommit => 1});
            };  warn $@ if $@;
          

        unless ( $dbHandle )  {
            $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                    $NetScript::Interpreter::FATAL_EVENT, 
                    "Error while connecting to the database: ".$DBI::errstr );
            return;                    
            }
        $settings -> { "handle" } = $dbHandle;
        }

    # now we can execute the statement...
    my $statement = $node -> getAttribute( "query" );
    if ( $statement eq "" ) {
        $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                $NetScript::Interpreter::FATAL_EVENT, 
                "You must specify the \"query\"-attribute!" );
        return;
        }

    
    my $se = $this -> interpreter() -> getStatementEvaluator();
    $statement = $se -> evaluateStatement( $statement );
    my $resultSet = $dbHandle -> prepare( $statement );
    $resultSet -> execute();

    my $name = $node -> getAttribute( "name" );
    my $var = $node -> getAttribute( "var" );
    if ( $var ne "" || $name ne "" ) {
        my $classWrapper = NetScript::Engine::ClassWrapper -> new( $this );
        $classWrapper -> setUserValue( "resultSet", $resultSet );
        $classWrapper -> setFunction( "nextLine", "getNextLine" );
        $classWrapper -> setMember( "lineFetched", "","getLineFetched" );
        $classWrapper -> setMember( "currentLine", "","getCurrentLine" );
        $classWrapper -> setMember( "headings", "","getHeadings");
        $classWrapper -> setMember( "content", "","getContent" );
        
        if ( $name ne "" && $var eq "" ) {
            $se -> createVariable( $name, $classWrapper );
            }
        elsif ( $name eq "" && $var ne "" ) {
            $se -> setVariable( $var, $classWrapper );
            }
        else {
            $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                    $NetScript::Interpreter::FATAL_EVENT, 
                    "You must specify either the \"name\" or the \"var\" attribute, not both." );
            }
        }
    else {
        $resultSet -> finish();
        }
    $domWalker -> stepSourceNext();
    }

#/**
# Returns the number of remaining lines in the result set...
#*/
sub getLineFetched {
    my ( $this, $member ) = @_;
    my $class = $member -> getParent();
    return $class -> getUserValue( "lastFetchOK" );
    }

#/**
# Returns the line number of the currently fetched line
#*/
sub getCurrentLine {
    my ( $this, $member ) = @_;
    my $class = $member -> getParent();
    return $class -> getUserValue( "lineNumber" );
    }

#/**
# Returns the headings of the result set
#*/
sub getHeadings {
    my ( $this, $member ) = @_;
    my $class = $member -> getParent();
    my $names = $class -> getUserValue( "names" ); 
    unless ( defined( $names ) ) {
        $class -> setUserValues( "names", $class -> getUserValue( "resultSet" )
            -> { NAMES } );
        }
    $names = $class -> getUserValue( "names" );
    return $names;
    }

#/**
# Returns the content of the currently fetched line
#*/
sub getContent {
    my ( $this, $member ) = @_;
    my $class = $member -> getParent();
    $class -> getUserValue( "content" );
    }

#/**
# Fetches a line..
#*/
sub getNextLine {
    my ( $this, $function ) = @_;
    my $class = $function -> getParent();
    my $reference = $class -> getUserValue( "resultSet" ) -> fetchrow_arrayref();
    if ( defined( $reference ) ) {
        my @contents = ();
        for ( @{$reference} ) {
            my $aMember = NetScript::Engine::Member -> new();
            $aMember -> setValue( $_ );
            push( @contents, $aMember );
            }
        $class -> setUserValue( "content", \@contents );
        $class -> setUserValue( "lineNumber", $class -> getUserValue( "lineNumber" ) + 1 );
        $class -> setUserValue( "lastFetchOK", 1 );
        }
    else {
        $class -> setUserValue( "lastFetchOK", 0 );
        $class -> getUserValue( "resultSet" ) -> finish();
        }
    }

#/**
# Called when an element starts.
# @param an instance of NetScript::Engine::Event
#*/
sub elementStarted {
    my ( $this, $event ) = @_;
    my $domWalker = $event -> getEventUnknown();
    my $refNode = $domWalker -> currentSource();
    if ( $refNode -> getNamespaceURI() eq $DB_NAMESPACE_URI ) {
        my $nodeName = $refNode -> getLocalName();
        
        if ( $nodeName eq "settings" ) {
            $this -> processSettings( $domWalker, $refNode );
            return 0; # consume event
            }
        elsif ( $nodeName eq "exec" ) {
            $this -> runStatement( $domWalker, $refNode );
            return 0; #consume event
            }
        }
    return 1; # do not consume event
    }


#/**
# Called, when an element is finished...
# @param an instance of NetScript::Engine::Event
#*/
sub elementFinished {
    my ( $this, $event ) = @_;
    my $domWalker = $event -> getEventUnknown();
    my $refNode = $domWalker -> currentSource();
    if ( $refNode -> getNamespaceURI() eq $DB_NAMESPACE_URI ) {
        my $nodeName = $refNode -> getLocalName();
        
        if ( $nodeName eq "settings" ) {
            return 0; # consume event
            }
        elsif ( $nodeName eq "exec" ) {
            return 0; #consume event
            }
        }
    return 1; # do not consume event
    }

sub getName {
    "DatabaseLibrary";
    }

sub getVersion {
    1.0;
    }

sub getDescription {
    "This Library adds Database support to NetScript.";
    }


1; # make require happy

Index: ClassLibrary.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/ClassLibrary.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** ClassLibrary.pm	24 Jul 2002 22:46:32 -0000	1.2
--- ClassLibrary.pm	7 Aug 2002 20:13:55 -0000	1.3
***************
*** 31,36 ****
  #       &lt;/ns:method&gt;
  #       
! #       &lt;ns:method name=&quot;setColor&quot; parameters=&quot;value&quot;&gt;
! #           &lt;ns:var var=&quot;this.wheels&quot; val=&quot;$(value)&quot;/&gt;
  #       &lt;/ns:method&gt;
  #   &lt;/ns:class&gt;
--- 31,40 ----
  #       &lt;/ns:method&gt;
  #       
! #       &lt;ns:method name=&quot;setColor&quot; byVal=&quot;value&quot;&gt;
! #           &lt;ns:var var=&quot;this.color&quot; val=&quot;$(value)&quot;/&gt;
! #       &lt;/ns:method&gt;
! #
! #       &lt;ns:method name=&quot;getColor&quot; byRef=&quot;value&quot;&gt;
! #           &lt;ns:var name=&quot;value&quot; val=&quot;$(this.color)&quot;/&gt;
  #       &lt;/ns:method&gt;
  #   &lt;/ns:class&gt;
***************
*** 219,223 ****
      my $classObject = $this -> interpreter() -> getStatementEvaluator() -> 
              resolveObjectValue( $objectName );
!     unless( UNIVERSAL::isa( $classObject, "NetScript::Engine::Class" ) ) {
          $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                  $NetScript::Interpreter::FATAL_EVENT, 
--- 223,228 ----
      my $classObject = $this -> interpreter() -> getStatementEvaluator() -> 
              resolveObjectValue( $objectName );
!     unless( UNIVERSAL::isa( $classObject, "NetScript::Engine::Class" ) ||
!             UNIVERSAL::isa( $classObject, "NetScript::Engine::ClassWrapper") ) {
          $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                  $NetScript::Interpreter::FATAL_EVENT, 
***************
*** 228,232 ****
      my $methodName = $node -> getAttribute( "method" );           
      my $methodObject = $classObject -> getFunction( $methodName );
!     unless( UNIVERSAL::isa( $methodObject, "NetScript::Engine::Function" ) ) {
          $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                  $NetScript::Interpreter::FATAL_EVENT, 
--- 233,238 ----
      my $methodName = $node -> getAttribute( "method" );           
      my $methodObject = $classObject -> getFunction( $methodName );
!     unless( UNIVERSAL::isa( $methodObject, "NetScript::Engine::Function" ) ||
!             UNIVERSAL::isa( $methodObject, "NetScript::Engine::FunctionWrapper" ) ) {
          $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                  $NetScript::Interpreter::FATAL_EVENT, 
***************
*** 234,237 ****
--- 240,244 ----
          return;        
          }
+ 
      $this -> invokeAMethod( $classObject, $methodObject, $node, $domWalker);
      }
***************
*** 246,288 ****
      my ( $this, $classObject, $methodObject, $node, $domWalker ) = @_;
      my $se = $this -> interpreter() -> getStatementEvaluator();
- #    $node -> appendChild( $methodObject -> getCode() ); # append code
  
!     my @paramsByVal = @{ $methodObject -> getValueParameters() };
!     my @paramsByRef = @{ $methodObject -> getReferenceParameters() };
!     
!     my %valParams = ();
!     for ( @paramsByVal  ) {
!         my $paramName = $_;
!         my $paramValue = $node -> getAttribute( $paramName );
!         $paramValue = $se -> evaluateStatement( $paramValue );
!         $valParams{ $paramName } = $paramValue;
          }
      
!     my %refParams = ();
!     for ( @paramsByRef ) {
!         my $paramName = $_;
!         my $paramValue = $node -> getAttribute( $paramName );
!         $paramValue = $se -> evaluateStatement( $paramValue );
!         my $memberObject = $se -> resolveObject( $paramValue );
!         $refParams{ $paramName } = $memberObject;
!         }
!     # create new state tree    
!     $this -> interpreter() -> newStateTree();
!     # create this pointer
!     $se -> createVariable( "this", $classObject );
! 
!     # create variables for parameters
!     for ( keys( %valParams ) ) {
!         $se -> createVariable( $_, $valParams{ $_  } );
!         }
      
!     my $newState = $this -> interpreter() -> getState();
!     for ( keys( %refParams ) ) {
!         $newState -> createVariableValue( $_, $refParams{ $_ } );
          }
- 
-     $this -> pushNode( $node );
-     $domWalker -> setCurrentSource( $methodObject -> getCode() );
-     $domWalker -> stepSourceIn();
      }
  
--- 253,310 ----
      my ( $this, $classObject, $methodObject, $node, $domWalker ) = @_;
      my $se = $this -> interpreter() -> getStatementEvaluator();
  
!     # Do Wrapped calls
!     if ( UNIVERSAL::isa( $methodObject, "NetScript::Engine::FunctionWrapper" ) ) {
!         my @params = @{ $methodObject -> getParameters() };
!         my %valParams = ();
!         for ( @params  ) {
!             my $paramName = $_;
!             my $paramValue = $node -> getAttribute( $paramName );
!             $paramValue = $se -> evaluateStatement( $paramValue );
!             $valParams{ $paramName } = $paramValue;
!             }
!         $methodObject -> invoke( %valParams );
!         $domWalker -> stepSourceNext();
          }
+     # Do normal calls
+     else {
+         my @paramsByVal = @{ $methodObject -> getValueParameters() };
+         my @paramsByRef = @{ $methodObject -> getReferenceParameters() };
+         
+         my %valParams = ();
+         for ( @paramsByVal  ) {
+             my $paramName = $_;
+             my $paramValue = $node -> getAttribute( $paramName );
+             $paramValue = $se -> evaluateStatement( $paramValue );
+             $valParams{ $paramName } = $paramValue;
+             }
+         
+         my %refParams = ();
+         for ( @paramsByRef ) {
+             my $paramName = $_;
+             my $paramValue = $node -> getAttribute( $paramName );
+             $paramValue = $se -> evaluateStatement( $paramValue );
+             my $memberObject = $se -> resolveObject( $paramValue );
+             $refParams{ $paramName } = $memberObject;
+             }
+         # create new state tree    
+         $this -> interpreter() -> newStateTree();
+         # create this pointer
+         $se -> createVariable( "this", $classObject );
      
!         # create variables for parameters
!         for ( keys( %valParams ) ) {
!             $se -> createVariable( $_, $valParams{ $_  } );
!             }
!         
!         my $newState = $this -> interpreter() -> getState();
!         for ( keys( %refParams ) ) {
!             $newState -> createVariableValue( $_, $refParams{ $_ } );
!             }
      
!         $this -> pushNode( $node );
!         $domWalker -> setCurrentSource( $methodObject -> getCode() );
!         $domWalker -> stepSourceIn();
          }
      }
  
***************
*** 290,294 ****
  # Called when method invocation is finished.
  # @param an instance of NetScript::Engine::DOMWalker
! # @param an instance of XML::DOM2::Element (the invoke-node)
  # @callback
  #*/
--- 312,316 ----
  # Called when method invocation is finished.
  # @param an instance of NetScript::Engine::DOMWalker
! # @param an instance of XML::DOM2::Element (the method-node)
  # @callback
  #*/

Index: ControlStructuresLibrary.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/ControlStructuresLibrary.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** ControlStructuresLibrary.pm	24 Jul 2002 22:47:03 -0000	1.7
--- ControlStructuresLibrary.pm	7 Aug 2002 20:13:55 -0000	1.8
***************
*** 209,212 ****
--- 209,213 ----
  warn "EVAL: $test";
      $test = $se -> evaluateStatement( $test );
+ warn "EVAL: $test";
      eval( $test );
      }

[NetScript CVS] CVS: netscript2/src/perl/NetScript/Engine ClassWrapper.pm,1.1,1.2 Function.pm,1.2,1.3 FunctionWrapper.pm,1.1,1.2 MemberWrapper.pm,1.2,1.3 StatementEvaluator.pm,1.10,1.11

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

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

Modified Files:
	ClassWrapper.pm Function.pm FunctionWrapper.pm 
	MemberWrapper.pm StatementEvaluator.pm 
Log Message:
* added database library


Index: ClassWrapper.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/ClassWrapper.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** ClassWrapper.pm	2 Jun 2002 19:31:23 -0000	1.1
--- ClassWrapper.pm	7 Aug 2002 20:13:48 -0000	1.2
***************
*** 35,41 ****
      my $proto = shift;                  # get Prototype
      my $class = ref( $proto ) || $proto;# get the Classname
! 
      my $this = $class -> SUPER::new();
      $this -> { m_Object } = $object;
      return $this;                       # return Object
      }
--- 35,42 ----
      my $proto = shift;                  # get Prototype
      my $class = ref( $proto ) || $proto;# get the Classname
!     my %userValues = ();
      my $this = $class -> SUPER::new();
      $this -> { m_Object } = $object;
+     $this -> { m_userValues } = \%userValues;
      return $this;                       # return Object
      }
***************
*** 49,58 ****
  # @param the name of the sub which should be called upon invocation
  # of the function.
  #*/
  sub setFunction {
!     my ($this, $function, $subToCall ) = @_;
!     my $wrapper = NetScript::Engine::FunctionWrapper -> new( 
!         $this -> object(), $function, $subToCall );
      $this -> functions() -> { $function } = $wrapper;
      }
  
--- 50,61 ----
  # @param the name of the sub which should be called upon invocation
  # of the function.
+ # @return the created functionWrapper object
  #*/
  sub setFunction {
!     my ($this, $function, $subToCall, @paramNames ) = @_;
!     my $wrapper = NetScript::Engine::FunctionWrapper -> new( $this, 
!         $this -> object(), $function, $subToCall, @paramNames );
      $this -> functions() -> { $function } = $wrapper;
+     $wrapper;
      }
  
***************
*** 67,70 ****
--- 70,74 ----
  # @param the name of the sub to be called on setting of the member
  # @param the name of the sub to be called on retrieval of the member.
+ # @return the created memberwrapper object
  # @public
  #*/
***************
*** 74,81 ****
          $this  -> object(), $subOnSetting, $subOnRetrieval );
      $this -> members() -> { $member } = $memberWrapper;
      }
  
  
! sub member {
      my ( $this, $member ) = @_;
      for ( keys( %{$this -> members() } ) ) {
--- 78,89 ----
          $this  -> object(), $subOnSetting, $subOnRetrieval );
      $this -> members() -> { $member } = $memberWrapper;
+     $memberWrapper;
      }
  
  
! #/**
! # Returns the member value or undef, if there is no such member...
! #*/
! sub getMember {
      my ( $this, $member ) = @_;
      for ( keys( %{$this -> members() } ) ) {
***************
*** 96,99 ****
--- 104,127 ----
      my ( $this ) = @_;
      $this -> { m_Object };
+     }
+ 
+ 
+ #/**
+ # This can be used to store user values in the object
+ # @param the name of the value
+ # @param the value of the value ;)
+ #*/
+ sub setUserValue {
+     my ( $this, $name, $value )  = @_;
+     $this -> { m_userValues } -> { $name } = $value;
+     }
+ 
+ #/**
+ # Retrieves a previously stored user value from the object.
+ # @param the name of the value to retrieve
+ #*/
+ sub getUserValue {
+     my ( $this, $name ) = @_;
+     $this -> { m_userValues } -> { $name };
      }
  

Index: Function.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/Function.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** Function.pm	11 Jul 2002 22:03:09 -0000	1.2
--- Function.pm	7 Aug 2002 20:13:49 -0000	1.3
***************
*** 26,30 ****
  #*/
  sub new {
!     my ($proto, $parent) = @_;
      my $proto = shift;                  # get Prototype
      my $class = ref( $proto ) || $proto;# get the Classname
--- 26,30 ----
  #*/
  sub new {
!     my ($proto, $parent, $name) = @_;
      my $proto = shift;                  # get Prototype
      my $class = ref( $proto ) || $proto;# get the Classname
***************
*** 34,38 ****
      my @valueParameters = ();
      my @referenceParameters = ();
!     $this -> { m_Name } = "";
      $this -> { m_Parent } = $parent;    # parent class
      $this -> { m_Code } = undef;        # executable code
--- 34,38 ----
      my @valueParameters = ();
      my @referenceParameters = ();
!     $this -> { m_Name } = $name;
      $this -> { m_Parent } = $parent;    # parent class
      $this -> { m_Code } = undef;        # executable code

Index: FunctionWrapper.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/FunctionWrapper.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** FunctionWrapper.pm	2 Jun 2002 19:31:23 -0000	1.1
--- FunctionWrapper.pm	7 Aug 2002 20:13:49 -0000	1.2
***************
*** 14,19 ****
  #*/
  package NetScript::Engine::FunctionWrapper;
! use base qw(NetScript::Engine::Function);
! 
  
  #--------------------------------------------------------
--- 14,18 ----
  #*/
  package NetScript::Engine::FunctionWrapper;
! use base qw(NetScript::Engine::Function); 
  
  #--------------------------------------------------------
***************
*** 24,53 ****
  #/**
  # Ctor.
- # @param the parent class object of this function.
  # @param the object on which the sub should be invocated
  # @param the sub to be called upon invocation of this function.
  #*/
  sub new {
!     my ($proto, $parent, $object, $subToCall ) = @_;
      my $proto = shift;                  # get Prototype
      my $class = ref( $proto ) || $proto;# get the Classname
! 
!     my $this = $class -> SUPER::new( $parent );
      $this -> { m_Object } = $object;
      $this -> { m_SubToCall } = $subToCall;
      return $this;                       # return Object
      }
  
! 
  
  #/**
! # Invokes this sub. A list of parameters is given as argument
  # @optional one or more parameters 
  #*/
  sub invoke {
!     my ( $this, @args ) = @_;
      my $sub = $this -> { m_SubToCall };
!     $this -> { m_Object } -> $sub( @args );
      }
  
  1; # make "require" happy    
--- 23,81 ----
  #/**
  # Ctor.
  # @param the object on which the sub should be invocated
  # @param the sub to be called upon invocation of this function.
+ # @param the names of the parameters
  #*/
  sub new {
!     my ($proto, $parent, $object, $name, $subToCall, @paramNames ) = @_;
      my $proto = shift;                  # get Prototype
      my $class = ref( $proto ) || $proto;# get the Classname
!     my %userValues = ();
!     my $this = $class -> SUPER::new( $parent, $name );
!     
!     $this -> { m_userValues } = \%userValues;
      $this -> { m_Object } = $object;
      $this -> { m_SubToCall } = $subToCall;
+     $this -> { m_paramNames } = \@paramNames;
      return $this;                       # return Object
      }
  
! #/**
! # Returns a reference to list of parameter names for this function.
! #*/
! sub getParameters {
!     my ( $this ) = @_;
!     return $this -> { m_paramNames };
!     }
  
  #/**
! # Invokes this sub. A hash of parameters is given as argument
  # @optional one or more parameters 
  #*/
  sub invoke {
!     my ( $this, %args ) = @_;
      my $sub = $this -> { m_SubToCall };
!     $this -> { m_Object } -> $sub( $this, %args );
!     }
! 
! #/**
! # This can be used to store user values in the object
! # @param the name of the value
! # @param the value of the value ;)
! #*/
! sub setUserValue {
!     my ( $this, $name, $value )  = @_;
!     $this -> { m_userValues } -> { $name } = $value;
!     }
! 
! #/**
! # Retrieves a previously stored user value from the object.
! # @param the name of the value to retrieve
! #*/
! sub getUserValue {
!     my ( $this, $name ) = @_;
!     $this -> { m_userValues } -> { $name };
      }
+ 
  
  1; # make "require" happy    

Index: MemberWrapper.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/MemberWrapper.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** MemberWrapper.pm	11 Jul 2002 22:03:09 -0000	1.2
--- MemberWrapper.pm	7 Aug 2002 20:13:49 -0000	1.3
***************
*** 35,40 ****
      my $proto = shift;                  # get Prototype
      my $class = ref( $proto ) || $proto;# get the Classname
! 
      my $this = $class -> SUPER::new( $parent );
      $this -> { m_Name } = "";
      $this -> { m_SubOnSetting } = $subOnSetting;
--- 35,41 ----
      my $proto = shift;                  # get Prototype
      my $class = ref( $proto ) || $proto;# get the Classname
!     my %userValues = ();
      my $this = $class -> SUPER::new( $parent );
+     $this -> { m_userValues } = \%userValues;
      $this -> { m_Name } = "";
      $this -> { m_SubOnSetting } = $subOnSetting;
***************
*** 60,64 ****
      my ( $this ) = @_;
      my $sub = $this -> { m_SubOnRetrieval };
!     $this -> { m_Object } -> $sub ( $this -> { m_Name } );
      }
  
--- 61,65 ----
      my ( $this ) = @_;
      my $sub = $this -> { m_SubOnRetrieval };
!     $this -> { m_Object } -> $sub ( $this, $this -> { m_Name } );
      }
  
***************
*** 70,74 ****
      my ( $this, $value ) = @_;
      my $sub = $this -> { m_SubOnSetting };
!     $this -> { m_Object } -> $sub( $this -> { m_Name }, $value );
      }
  
--- 71,75 ----
      my ( $this, $value ) = @_;
      my $sub = $this -> { m_SubOnSetting };
!     $this -> { m_Object } -> $sub( $this, $this -> { m_Name }, $value );
      }
  
***************
*** 81,89 ****
      my ( $this ) = @_;
      my $clone = NetScript::Engine::MemberWrapper -> new (
!         $this -> parent(), $this -> { m_Object },
          $this -> { m_SubOnSetting }, $this -> { m_SubOnRetrieval }
          );
      $clone;    
      }
  
  1; # make "require" happy    
--- 82,110 ----
      my ( $this ) = @_;
      my $clone = NetScript::Engine::MemberWrapper -> new (
!         $this -> getParent(), $this -> { m_Object },
          $this -> { m_SubOnSetting }, $this -> { m_SubOnRetrieval }
          );
      $clone;    
      }
+ 
+ #/**
+ # This can be used to store user values in the object
+ # @param the name of the value
+ # @param the value of the value ;)
+ #*/
+ sub setUserValue {
+     my ( $this, $name, $value )  = @_;
+     $this -> { m_userValues } -> { $name } = $value;
+     }
+ 
+ #/**
+ # Retrieves a previously stored user value from the object.
+ # @param the name of the value to retrieve
+ #*/
+ sub getUserValue {
+     my ( $this, $name ) = @_;
+     $this -> { m_userValues } -> { $name };
+     }
+ 
  
  1; # make "require" happy    

Index: StatementEvaluator.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/StatementEvaluator.pm,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** StatementEvaluator.pm	11 Jul 2002 22:03:09 -0000	1.10
--- StatementEvaluator.pm	7 Aug 2002 20:13:49 -0000	1.11
***************
*** 185,192 ****
  
      # continue until all is resolved
      while ( $toResolve =~ /^([^\.]+)\.?(.*)$/ ) {
          my $memberName = $1;
          $toResolve = $2;
! 
          # we got a MEMBER in $object, so we now extract its value
          # which must be a CLASS
--- 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
***************
*** 199,205 ****
  
          $index = -1;
!         if ( $memberName =~ /^([^:])+:([0-9]+)$/ ) {
              $memberName = $1;
              $index = $2;
              }
  
--- 200,207 ----
  
          $index = -1;
!         if ( $memberName =~ /^([^:]+):([0-9]+)$/ ) {
              $memberName = $1;
              $index = $2;
+ warn "Is Array: Splitting: MemberName=$memberName, index=$index"
              }
  
***************
*** 217,220 ****
--- 219,226 ----
              return undef;
              }
+         }
+ 
+     if ( $index != -1 ) {
+         $object = $object -> getValue() -> [ $index ]; # is an array
          }
      

[NetScript CVS] CVS: netscript2/src/perl/NetScript/Libraries ControlStructuresLibrary.pm,1.6,1.7

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

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

Modified Files:
	ControlStructuresLibrary.pm 
Log Message:
* bugfixes

Index: ControlStructuresLibrary.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/ControlStructuresLibrary.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** ControlStructuresLibrary.pm	11 Jul 2002 22:03:10 -0000	1.6
--- ControlStructuresLibrary.pm	24 Jul 2002 22:47:03 -0000	1.7
***************
*** 169,172 ****
--- 169,173 ----
      my $domWalker = $event -> getEventUnknown();
      my $node = $domWalker -> currentSource();
+ 
      if ( $node -> getNamespaceURI() eq $NetScript::Interpreter::NAMESPACE_URI ) {
          if ($node -> getLocalName() eq "if") {
***************
*** 206,209 ****
--- 207,211 ----
      # replace variables
      my $se = $this -> interpreter() -> getStatementEvaluator();
+ warn "EVAL: $test";
      $test = $se -> evaluateStatement( $test );
      eval( $test );
***************
*** 217,220 ****
--- 219,223 ----
  #*/
  sub ifStart {
+ warn "IF !!!!!!\n"    ;
      my ( $this, $domWalker, $node ) = @_;
      # check condition
***************
*** 227,230 ****
--- 230,234 ----
      else {
          # condition is true, proceed as usual
+ warn "TEST SUCCESS!" ;
          $this -> interpreter() -> newState();
          $domWalker -> stepSourceIn();
***************
*** 282,293 ****
      my ( $this, $domWalker, $node ) = @_;
      # check condition
!     if ( $this -> checkNodeTest( $node ) ) {
          # test did not succeed, so we jump to the next sibling if any        
          $domWalker -> stepSourceNext();
          }
      else {
          # condition is true, proceed as usual
-         $domWalker -> stepSourceIn();
          $this -> interpreter() -> newState();
          }
      }
--- 286,298 ----
      my ( $this, $domWalker, $node ) = @_;
      # check condition
!     unless ( $this -> checkNodeTest( $node ) ) {
          # test did not succeed, so we jump to the next sibling if any        
+         $this -> interpreter() -> newState();
          $domWalker -> stepSourceNext();
          }
      else {
          # condition is true, proceed as usual
          $this -> interpreter() -> newState();
+         $domWalker -> stepSourceIn();
          }
      }

[NetScript CVS] CVS: netscript2/src/perl/NetScript/Libraries ClassLibrary.pm,1.1,1.2

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

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

Modified Files:
	ClassLibrary.pm 
Log Message:
* added possibility of recursive function calls
* overall speedup
* fixed minor bugs

Index: ClassLibrary.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/ClassLibrary.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** ClassLibrary.pm	11 Jul 2002 22:03:10 -0000	1.1
--- ClassLibrary.pm	24 Jul 2002 22:46:32 -0000	1.2
***************
*** 64,71 ****
--- 64,93 ----
      my $this = $class -> SUPER::new();
      my %knownClasses = ();
+     my @callStack = ();
      $this -> { m_knownClasses } = \%knownClasses;
+     $this -> { m_callStack } = \@callStack;
      $this;
      }
  
+ #/**
+ # Pushes the given node onto the call stack.
+ # @param an instance of XML::DOM2::Node
+ # @private
+ #*/
+ sub pushNode {
+     my ( $this, $node ) = @_;
+     push( @{ $this -> { m_callStack } }, $node );
+     }
+ 
+ #/**
+ # Pops the topmost node from the call stack.
+ # @return an instance of XML::DOM2::Node
+ # @private
+ #*/
+ sub popNode {
+     my ( $this ) = @_;
+     pop( @{ $this -> { m_callStack } } );
+     }
+ 
  
  sub init {
***************
*** 216,229 ****
  
  #/**
! # Invokes a method. Method code will be appended
! # to the given element and the dom walker will walk over it.
  # @param an instance of NetScript::Engine::Class
  # @param an instance of NetScript::Engine::Function
! # @param an instance of XML::DOM2::Element
  #*/
  sub invokeAMethod {
      my ( $this, $classObject, $methodObject, $node, $domWalker ) = @_;
      my $se = $this -> interpreter() -> getStatementEvaluator();
!     $node -> appendChild( $methodObject -> getCode() ); # append code
      my @paramsByVal = @{ $methodObject -> getValueParameters() };
      my @paramsByRef = @{ $methodObject -> getReferenceParameters() };
--- 238,251 ----
  
  #/**
! # Invokes a method. 
  # @param an instance of NetScript::Engine::Class
  # @param an instance of NetScript::Engine::Function
! # @param an instance of XML::DOM2::Element - the invoke node
  #*/
  sub invokeAMethod {
      my ( $this, $classObject, $methodObject, $node, $domWalker ) = @_;
      my $se = $this -> interpreter() -> getStatementEvaluator();
! #    $node -> appendChild( $methodObject -> getCode() ); # append code
! 
      my @paramsByVal = @{ $methodObject -> getValueParameters() };
      my @paramsByRef = @{ $methodObject -> getReferenceParameters() };
***************
*** 260,263 ****
--- 282,287 ----
          }
  
+     $this -> pushNode( $node );
+     $domWalker -> setCurrentSource( $methodObject -> getCode() );
      $domWalker -> stepSourceIn();
      }
***************
*** 271,297 ****
  sub invokeFinished {
      my ( $this, $domWalker, $node ) = @_;
-     # remove code subtree from node.
-     $node -> removeChild( $node -> getFirstChild() );
      # restore old state
      $this -> interpreter() -> dropStateTree();
      }
  
- #/**
- # Called when object creation is finished.
- # @param an instance of NetScript::Engine::DOMWalker
- # @param an instance of XML::DOM2::Element (the new-node)
- # @callback
- #*/
- sub newFinished {
-     my ( $this, $domWalker, $node ) = @_;
- 
-     # if node has no child nodes there was no ctor invoked
-     if ( $node -> hasChildNodes() ) {
-         # remove code subtree from node.
-         $node -> removeChild( $node -> getFirstChild() );
-         # restore old state
-         $this -> interpreter() -> dropStateTree();
-         }
-     }
  
  #/**
--- 295,308 ----
  sub invokeFinished {
      my ( $this, $domWalker, $node ) = @_;
      # restore old state
      $this -> interpreter() -> dropStateTree();
+     # get return address
+     my $nextNode = $this -> popNode();
+     # set return node
+     $domWalker -> setCurrentSource( $nextNode );
+     # step to next node
+     $domWalker -> stepSourceNext();
      }
  
  
  #/**
***************
*** 356,367 ****
              }
          if ( $localName eq "invoke" ) {
-             $this -> invokeFinished( $domWalker, $node );
              return 0; # consume event
              }
          if ( $localName eq "new" ) {
-             $this -> newFinished( $domWalker, $node );
              return 0; # consume event
              }
          if ( $localName eq "method" ) {
              return 0; #consume event
              }
--- 367,377 ----
              }
          if ( $localName eq "invoke" ) {
              return 0; # consume event
              }
          if ( $localName eq "new" ) {
              return 0; # consume event
              }
          if ( $localName eq "method" ) {
+             $this -> invokeFinished( $domWalker, $node );
              return 0; #consume event
              }

[NetScript CVS] CVS: netscript2 Makefile,1.9,1.10

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

Update of /cvsroot/net-script/netscript2
In directory usw-pr-cvs1:/tmp/cvs-serv7653

Modified Files:
	Makefile 
Log Message:
* added target for building the whole documentation

Index: Makefile
===================================================================
RCS file: /cvsroot/net-script/netscript2/Makefile,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** Makefile	7 Jul 2002 14:47:32 -0000	1.9
--- Makefile	11 Jul 2002 22:08:03 -0000	1.10
***************
*** 96,99 ****
--- 96,105 ----
  	perl -Isrc/tools src/tools/ipdoc.pl -d ./$(DOCS_DIR)/netscript/api -f src/perl/NetScript -t "NetScript 2.0 Documentation" -desc ./$(DOCS_DIR)/netscript/REQUIREMENTS.html
  
+ docs_all: docs_ipdoc docs_dom2 docs_netscript
+ 
+ docs_all_in_one:
+ 	-rm -rf $(DOCS_DIR)/all/api
+ 	perl -Isrc/tools src/tools/ipdoc.pl -d ./$(DOCS_DIR)/all/api -f src/tools/,src/perl/ -t "NetScript 2.0 and Components"
+     
  # Creates a package for DOM2
  #---------------------------

[NetScript CVS] CVS: netscript2/src/perl/XML/DOM2 Node.pm,1.21,1.22

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

Update of /cvsroot/net-script/netscript2/src/perl/XML/DOM2
In directory usw-pr-cvs1:/tmp/cvs-serv7268

Modified Files:
	Node.pm 
Log Message:
* various bugfixes and speed improvements

Index: Node.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/XML/DOM2/Node.pm,v
retrieving revision 1.21
retrieving revision 1.22
diff -C2 -d -r1.21 -r1.22
*** Node.pm	7 Jul 2002 14:35:53 -0000	1.21
--- Node.pm	11 Jul 2002 22:06:49 -0000	1.22
***************
*** 600,604 ****
  sub removeChild {
      my ( $this, $oldChild ) = @_;
- warn $this->getNodeName()." REMOVING: $oldChild....";
      # Check index of ref node.
      my $index = $this -> getChildNodes() -> indexOf( $oldChild );
--- 600,603 ----

[NetScript CVS] CVS: netscript2/src/perl/NetScript/Libraries ClassLibrary.pm,NONE,1.1 ControlStructuresLibrary.pm,1.5,1.6 FormsLibrary.pm,1.4,1.5 Library.pm,1.5,1.6 VariablesLibrary.pm,1.3,1.4 wipeout.project,1.5,1.6

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

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

Modified Files:
	ControlStructuresLibrary.pm FormsLibrary.pm Library.pm 
	VariablesLibrary.pm wipeout.project 
Added Files:
	ClassLibrary.pm 
Log Message:
* added support for classes and methods
* did a complete rewrite of the variable system
* various bugfixes

--- NEW FILE: ClassLibrary.pm ---
#--------------------------------------------------------
# $Id: ClassLibrary.pm,v 1.1 2002/07/11 22:03:10 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;

#/**
# The ClassLibrary is responsible for integrating classes and methods
# into Netscript. You can specify a class by using the class-statements.
# An example:
# <pre>
#   &lt;ns:class type=&quot;car&quot;&gt;
#       &lt;ns:member name=&quot;wheels&quot;/&gt;
#       &lt;ns:member name=&quot;color&quot;/&gt;
#       &lt;ns:member name=&quot;factory&quot;/&gt;
# 
#       &lt;ns:method name=&quot;INIT&quot;&gt;
#           <ns:new name="aFactory" class="Factory"/>
#           <ns:var var="this.factory" rval="aFactory"/>
#       &lt;/ns:method&gt;    
# 
#       &lt;ns:method name=&quot;printCarStats&quot;&gt;
#           &lt;table&gt;
#               &lt;tr&gt;&lt;th colspan=&quot;2&quot;&gt;Car stats&lt;/th&gt;&lt;/tr&gt;
#               &lt;tr&gt;&lt;td&gt;wheels&lt;/td&gt;&lt;td&gt;$(this.wheels)&lt;/td&gt;&lt;/tr&gt;
#           &lt;/table&gt;
#       &lt;/ns:method&gt;
#       
#       &lt;ns:method name=&quot;setColor&quot; parameters=&quot;value&quot;&gt;
#           &lt;ns:var var=&quot;this.wheels&quot; val=&quot;$(value)&quot;/&gt;
#       &lt;/ns:method&gt;
#   &lt;/ns:class&gt;
#
#   &lt;ns:var name=&quot;myCar&quot; class=&quot;car&quot;/&gt; &lt;!-- Create  a new instance of car --&gt;
#   &lt;ns:invoke var=&quot;myCar&quot; method=&quot;setColor&quot; value=&quot;red&quot;/&gt;
# </pre>
# New instances of objects are created via the <code>&lt;ns:var&gt;</code>
# statement. The <code>&lt;ns:invoke&gt;</code>-statement executes a 
# method of an object instance.
#*/
package NetScript::Libraries::ClassLibrary;
use base qw(NetScript::Libraries::Library);


use NetScript::Engine::EventListener;
use NetScript::Engine::EventRelay;
use NetScript::Engine::Class;
use NetScript::Engine::Function;
use NetScript::Engine::Member;
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();
    my %knownClasses = ();
    $this -> { m_knownClasses } = \%knownClasses;
    $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 when an element starts.
# @callback
#*/
sub elementStarted {
    my ( $this, $event ) = @_;
    my $domWalker = $event -> getEventUnknown();
    
    my $node = $domWalker -> currentSource();
    if ( $node -> getNamespaceURI() eq $NetScript::Interpreter::NAMESPACE_URI ) {
        my $localName = $node -> getLocalName();
        if ($localName eq "class") {
            $this -> processClass( $domWalker, $node );
            return 0; # consume event
            }
        if ($localName eq "invoke") {
            $this -> invokeMethod( $domWalker, $node );
            return 0; # consume event
            }
        if ($localName eq "new") {
            $this -> newInstance( $domWalker, $node );
            return 0; # consume event
            }
        if ($localName eq "method" ) {
            $domWalker -> stepSourceIn();
            return 0;# consume event
            }
        }
    return 1; # do not consume event
    }

#/**
# Creates a new instance of a class and stores it in a variable.
# Also calles the constructor of the class ( if any ).
# @param an instance of NetScript::Engine::DOMWalker
# @param an instance of XML::DOM2::Element
#*/
sub newInstance {
    my ( $this, $domWalker, $node ) = @_;
    my $var = $node -> getAttribute( "var" );
    my $name = $node -> getAttribute( "name" );
    my $class = $node -> getAttribute( "class" );

    my $se = $this -> interpreter() -> getStatementEvaluator();
    $class = $se -> evaluateStatement( $class );

    my $classProto = $this -> { m_knownClasses } -> { $class };
    unless( defined( $classProto ) ) {
        $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                $NetScript::Interpreter::FATAL_EVENT, 
                "The class $class is unknown." );
        return;        
        }
    
    my $classInstance = NetScript::Engine::Class -> new();
    my @members = @{ $classProto -> membersList() };
    for ( @members ) {
        my $aMember = $_;
        my $newMember = NetScript::Engine::Member -> new();
        $newMember -> setName( $aMember -> getName() );
        $newMember -> setValue( 0 );
        $classInstance -> setMember( $newMember );
        }
    
    my @functions = @{ $classProto -> functionsList() };
    for ( @functions ) {
        my $aFunction = $_;
        my $newFunction = NetScript::Engine::Function -> new();
        $newFunction -> setName( $aFunction -> getName() );
        $newFunction -> setCode( $aFunction -> getCode() );
        $newFunction -> setValueParameters( @{ $aFunction -> getValueParameters() } );
        $newFunction -> setReferenceParameters( @{ $aFunction -> getReferenceParameters() } );
        $classInstance -> setFunction( $newFunction );
        }

    if ( defined( $name ) ) {
        $name = $se -> evaluateStatement( $name );
        $se -> createVariable( $name, $classInstance );
        }
    elsif ( defined( $var ) ) {
        $var = $se -> evaluateStatement( $var );
        $se -> setVariable( $var, $classInstance );
        }
    else {
        $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                $NetScript::Interpreter::FATAL_EVENT, 
                "Neither name nor var is defined. You must specify one of them." );
        return;        
        }

    # invoke constructor
    my $ctor = $classInstance -> getFunction( "INIT" );
    if ( defined( $ctor ) ) {
        $this -> invokeAMethod( $classInstance, $ctor, $node, $domWalker );
        }
    }

#/**
# Invokes the given method.
# @param an instance of NetScript::Engine::DOMWalker
# @param an instance of XML::DOM2::Element ( the invoke-node )
#*/
sub invokeMethod {
    my ( $this, $domWalker, $node ) = @_;
    my $objectName = $node -> getAttribute( "var" );
    my $classObject = $this -> interpreter() -> getStatementEvaluator() -> 
            resolveObjectValue( $objectName );
    unless( UNIVERSAL::isa( $classObject, "NetScript::Engine::Class" ) ) {
        $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                $NetScript::Interpreter::FATAL_EVENT, 
                "$objectName is no instance of a class." );
        return;        
        }
    
    my $methodName = $node -> getAttribute( "method" );           
    my $methodObject = $classObject -> getFunction( $methodName );
    unless( UNIVERSAL::isa( $methodObject, "NetScript::Engine::Function" ) ) {
        $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                $NetScript::Interpreter::FATAL_EVENT, 
                "$methodName is no method of $objectName." );
        return;        
        }
    $this -> invokeAMethod( $classObject, $methodObject, $node, $domWalker);
    }

#/**
# Invokes a method. Method code will be appended
# to the given element and the dom walker will walk over it.
# @param an instance of NetScript::Engine::Class
# @param an instance of NetScript::Engine::Function
# @param an instance of XML::DOM2::Element
#*/
sub invokeAMethod {
    my ( $this, $classObject, $methodObject, $node, $domWalker ) = @_;
    my $se = $this -> interpreter() -> getStatementEvaluator();
    $node -> appendChild( $methodObject -> getCode() ); # append code
    my @paramsByVal = @{ $methodObject -> getValueParameters() };
    my @paramsByRef = @{ $methodObject -> getReferenceParameters() };
    
    my %valParams = ();
    for ( @paramsByVal  ) {
        my $paramName = $_;
        my $paramValue = $node -> getAttribute( $paramName );
        $paramValue = $se -> evaluateStatement( $paramValue );
        $valParams{ $paramName } = $paramValue;
        }
    
    my %refParams = ();
    for ( @paramsByRef ) {
        my $paramName = $_;
        my $paramValue = $node -> getAttribute( $paramName );
        $paramValue = $se -> evaluateStatement( $paramValue );
        my $memberObject = $se -> resolveObject( $paramValue );
        $refParams{ $paramName } = $memberObject;
        }
    # create new state tree    
    $this -> interpreter() -> newStateTree();
    # create this pointer
    $se -> createVariable( "this", $classObject );

    # create variables for parameters
    for ( keys( %valParams ) ) {
        $se -> createVariable( $_, $valParams{ $_  } );
        }
    
    my $newState = $this -> interpreter() -> getState();
    for ( keys( %refParams ) ) {
        $newState -> createVariableValue( $_, $refParams{ $_ } );
        }

    $domWalker -> stepSourceIn();
    }

#/**
# Called when method invocation is finished.
# @param an instance of NetScript::Engine::DOMWalker
# @param an instance of XML::DOM2::Element (the invoke-node)
# @callback
#*/
sub invokeFinished {
    my ( $this, $domWalker, $node ) = @_;
    # remove code subtree from node.
    $node -> removeChild( $node -> getFirstChild() );
    # restore old state
    $this -> interpreter() -> dropStateTree();
    }

#/**
# Called when object creation is finished.
# @param an instance of NetScript::Engine::DOMWalker
# @param an instance of XML::DOM2::Element (the new-node)
# @callback
#*/
sub newFinished {
    my ( $this, $domWalker, $node ) = @_;

    # if node has no child nodes there was no ctor invoked
    if ( $node -> hasChildNodes() ) {
        # remove code subtree from node.
        $node -> removeChild( $node -> getFirstChild() );
        # restore old state
        $this -> interpreter() -> dropStateTree();
        }
    }

#/**
# Processes a class node.
# @param an instance of NetScript::Engine::DOMWalker
# @param an instance of XML::DOM2::Element (the class-node)
# @callback
#*/
sub processClass {
    my ( $this, $domWalker, $node ) = @_;
    my $classObject = NetScript::Engine::Class -> new();
    my $className = $node -> getAttribute( "name" );
    $classObject -> setName( $className );
    $this -> { m_knownClasses } -> { $className } = $classObject;
    
    # parse the subtree looking for methods and members
    my $children = $node -> getChildNodes();
    my $length = $children -> getLength() - 1;
    for ( 0..$length ) {
        my $child = $children -> item( $_ );
        if ( $child -> getNodeType() == $XML::DOM2::Node::ELEMENT_NODE ) {
            if ( $child -> getNamespaceURI() eq $NetScript::Interpreter::NAMESPACE_URI ) {
                if ( $child -> getLocalName() eq "member" ) {
                    my $memberObject = NetScript::Engine::Member -> new();
                    my $name = $child -> getAttribute( "name" );
                    $memberObject -> setName( $name );
                    $classObject -> setMember( $memberObject );
                    }
                elsif ( $child -> getLocalName() eq "method" ) {
                    my $functionObject = NetScript::Engine::Function -> new();
                    my $byValParameters = $child -> getAttribute( "byVal" );
                    my @valParams = split( /[\s,]+/, $byValParameters );
                    $functionObject -> setValueParameters( @valParams );
                    
                    my $byReferenceParameters = $child -> getAttribute( "byRef" );
                    my @refParams = split( /[\s,]+/, $byReferenceParameters );
                    $functionObject -> setReferenceParameters( @refParams );
                    
                    my $name = $child -> getAttribute( "name" );
                    $functionObject -> setName( $name );
                    $functionObject -> setCode( $child );
                    $classObject -> setFunction( $functionObject );
                    }
                }
            }
        }
    $domWalker -> stepSourceNext(); # do not step into the class declaration
    }

#/**
# Called when an element ends.
# @callback
#*/
sub elementFinished {
    my ( $this, $event ) = @_;
    my $domWalker = $event -> getEventUnknown();
    my $node = $domWalker -> currentSource();
    if ( $node -> getNamespaceURI() eq $NetScript::Interpreter::NAMESPACE_URI ) {
        my $localName = $node -> getLocalName();
        if ($localName eq "class") {
            return 0; # consume event
            }
        if ( $localName eq "invoke" ) {
            $this -> invokeFinished( $domWalker, $node );
            return 0; # consume event
            }
        if ( $localName eq "new" ) {
            $this -> newFinished( $domWalker, $node );
            return 0; # consume event
            }
        if ( $localName eq "method" ) {
            return 0; #consume event
            }
        }
    return 1; # do not consume event    
    }

sub getName {
    "ClassLibrary";
    }

sub getVersion {
    1.0;
    }

sub getDescription {
    "This Library adds Classes and Methods to NetScript.";
    }


1; # make require happy

Index: ControlStructuresLibrary.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/ControlStructuresLibrary.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** ControlStructuresLibrary.pm	7 Jul 2002 14:34:37 -0000	1.5
--- ControlStructuresLibrary.pm	11 Jul 2002 22:03:10 -0000	1.6
***************
*** 172,201 ****
          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
              }
          elsif( $node -> getLocalName() eq "ignore" ) {
              # Walk over the node
              $domWalker -> stepSourceIn();
!             0; #consume event
!             }
!         else {
!             1; # do not consume event
              }
          }
!     else {
!         1; # do not consume event
!         }
      }
  
--- 172,196 ----
          if ($node -> getLocalName() eq "if") {
              $this -> ifStart( $domWalker, $node );
!             return 0; # consume event
              }
          elsif( $node -> getLocalName() eq "else" ) {
              $this -> elseStart( $domWalker, $node );
!             return 0; # consume event
              }
          elsif ($node -> getLocalName() eq "while" ) {
              $this -> whileStart( $domWalker, $node );
!             return 0; # consume event
              }
          elsif ($node -> getLocalName() eq "for" ) {
              $this -> forStart( $domWalker, $node );
!             return 0; # consume event
              }
          elsif( $node -> getLocalName() eq "ignore" ) {
              # Walk over the node
              $domWalker -> stepSourceIn();
!             return 0; #consume event
              }
          }
!     return 1; # do not consume event
      }
  
***************
*** 364,368 ****
      
      my $value = $this -> { m_forLoops } -> {  $node };
- 
      unless ( defined( $value ) )  { # variable is yet unknown so we initialize it
          $value = $from;
--- 359,362 ----
***************
*** 376,394 ****
      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;
--- 370,380 ----
      if ( $createVar ) {
          # create variable
!         $this -> interpreter() -> getStatementEvaluator() ->
!                 createVariable( $theVar, $value );
          }
      else {
          # set variable 
!         $this -> interpreter() -> getStatementEvaluator() ->
!                 setVariable( $theVar, $value );
          }
      $this -> { m_forLoops } -> { $node } = $value;
***************
*** 419,427 ****
          # 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; 
  
--- 405,412 ----
          # if the variable value was changed in the loop we have to
          # reflect this in our internal setting.
+         my $se = $this -> interpreter() -> getStatementEvaluator();
          my $varName = $this -> { m_forLoopsVarNames } -> { $node };
!         $varName = $se -> evaluateStatement( $varName );
!         my $varValue = $se -> resolveObjectValue( $varName );
          $this -> { m_forLoops } -> { $node } = $varValue; 
  
***************
*** 443,471 ****
              # 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
              }
          elsif ($node -> getLocalName() eq "ignore" ) {
!             0; #consume event
!             }
!         else {
!             1; # do not consume event
              }
          }
!     else {
!         1; # do not consume event
!         }
      }
  
--- 428,451 ----
              # kill state
              $this -> interpreter() -> dropState();
!             return 0; # consume event 
              }
          elsif ($node -> getLocalName() eq "else") {
              # kill state
              $this -> interpreter() -> dropState();
!             return 0; # consume event 
              }
          elsif ($node -> getLocalName() eq "while" ) {
              $this -> whileEnd( $domWalker, $node );
!             return 0; # consume event
              }
          elsif ($node -> getLocalName() eq "for" ) {
              $this -> forEnd( $domWalker, $node );
!             return 0; # consume event
              }
          elsif ($node -> getLocalName() eq "ignore" ) {
!             return 0; #consume event
              }
          }
!     return 1; # do not consume event
      }
  
***************
*** 482,486 ****
      if ( $node -> getTarget() eq "netscript" ) {
          my $data = $node -> getData();
- warn "DATA: $data\n\n\n";
          if ( $data =~ /^\s*use\s*([^\s]*)/) { # check for "use LIBNAME"
              $this -> interpreter() -> getLibLoader() -> loadLibrary( $1 );
--- 462,465 ----
***************
*** 597,601 ****
                      my $document = $this -> interpreter() -> getDOMParser() ->
                              parseString( $fileData );
- warn "RIMPORT: Changing to $fileData ... > $document "                            ;
                      $domWalker -> resetDocument( $document );
                      $this -> addDocumentReference( $importPoint, $document, $sourceDocument );                            
--- 576,579 ----

Index: FormsLibrary.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/FormsLibrary.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** FormsLibrary.pm	7 Jul 2002 14:34:37 -0000	1.4
--- FormsLibrary.pm	11 Jul 2002 22:03:10 -0000	1.5
***************
*** 65,71 ****
  
      # register the P-object
!     $this -> interpreter() -> getState() -> createObjectValue( "P", $paramWrapper );
      # register the C-object
!     $this -> interpreter() -> getState() -> createObjectValue( "C", $cookieWrapper );
      
      # register event listeners for the cookie-tag
--- 65,71 ----
  
      # register the P-object
!     $this -> interpreter() -> getStatementEvaluator() -> createVariable( "P", $paramWrapper );
      # register the C-object
!     $this -> interpreter() -> getStatementEvaluator() -> createVariable( "C", $cookieWrapper );
      
      # register event listeners for the cookie-tag
***************
*** 185,204 ****
      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]" 
-             );
      }
  
--- 185,188 ----

Index: Library.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/Library.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** Library.pm	7 Jul 2002 14:34:37 -0000	1.5
--- Library.pm	11 Jul 2002 22:03:10 -0000	1.6
***************
*** 21,27 ****
  package NetScript::Libraries::Library;
  
- 
- 
- 
  #/**
  # Ctor. Creates a new Library Object.
--- 21,24 ----

Index: VariablesLibrary.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/VariablesLibrary.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** VariablesLibrary.pm	7 Jul 2002 14:34:37 -0000	1.3
--- VariablesLibrary.pm	11 Jul 2002 22:03:10 -0000	1.4
***************
*** 20,26 ****
  use base qw(NetScript::Libraries::Library);
  
- 
- 
- use NetScript::Libraries::DebugLibrary;
  use NetScript::Engine::EventListener;
  use NetScript::Engine::EventRelay;
--- 20,23 ----
***************
*** 119,130 ****
      $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();
      }
--- 116,149 ----
      $var = $se -> evaluateStatement( $var );
      my $value = $node -> getAttribute( "val");
!     my $rvalue = $node -> getAttribute( "rval" );
!     
!     if ( $rvalue eq "" && defined( $value ) ) {
!         $value = $se -> evaluateStatement( $value );
!         if ( $name ne "" && $var eq "" ) {
!             $se -> createVariable( $name, $value );
!             }
!         elsif( $name eq "" && $var ne "" ) {
!             $se -> setVariable( $var, $value );
!             }
          }
!     elsif( $rvalue ne "" ) {
!         $rvalue = $se -> evaluateStatement( $rvalue );
!         my $reference = $se -> resolveObject( $rvalue );
!         if ( $name ne "" && $var eq "" ) {
!             $this -> interpreter() -> getState() ->
!                 createVariableValue( $name, $reference );
!             }
!         elsif( $name eq "" && $var ne "" ) {
!             $this -> interpreter() -> getState() ->
!                 setVariableValue( $name, $reference );
!             }
          }
+     else {
+         $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
+                 $NetScript::Interpreter::FATAL_EVENT, 
+                 "Neither val nor rval is defined. You must specify one of them." );
+         return;        
+         }
+ 
      $domWalker -> stepSourceIn();
      }
***************
*** 134,153 ****
      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]" 
-             );
      }
  
--- 153,156 ----

Index: wipeout.project
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Libraries/wipeout.project,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** wipeout.project	29 May 2002 20:27:17 -0000	1.5
--- wipeout.project	11 Jul 2002 22:03:10 -0000	1.6
***************
*** 1,237 ****
  b
! C DmDictionary 0 10cf8 8 
! c 0 10e46 9 
! C Category 1 5426 
! c 0 10e86 4 
! C DmString 2 10e8d 2 e3 
! c 2 10e8c a defaultExe 
! C DmSet 3 10e8f 1 
! c 2 5435 2 e3 
! L 5435 
! c 2 10e8e b executables 
! c 3 10e8a 3 
! c 2 543c 3 *.C 
! L 543c 
! c 2 543f 4 *.cc 
! L 543f 
! c 2 5442 5 *.cpp 
! L 5442 
! c 2 10e89 a extensions 
! c 2 10e88 a CPP_source 
! c 2 10e87 4 name 
! c 2 10e48 a CPP_source 
! c 1 5457 
! c 0 10ecc 4 
! c 2 10ed3 2 e3 
! c 2 10ed2 a defaultExe 
! c 3 10ed5 1 
! c 2 5464 2 e3 
! L 5464 
! c 2 10ed4 b executables 
! c 3 10ed0 1 
! c 2 546b 3 *.c 
! L 546b 
! c 2 10ecf a extensions 
! c 2 10ece 8 C_source 
! c 2 10ecd 4 name 
! c 2 10e49 8 C_source 
! c 1 5480 
! c 0 10f06 4 
! c 2 10f0d 2 e3 
! c 2 10f0c a defaultExe 
! c 3 10f0f 1 
! c 2 548d 2 e3 
! L 548d 
! c 2 10f0e b executables 
! c 3 10f0a 1 
! c 2 5494 3 *.e 
! L 5494 
! c 2 10f09 a extensions 
! c 2 10f08 6 Eiffel 
! c 2 10f07 4 name 
! c 2 10e4a 6 Eiffel 
! c 1 54a9 
! c 0 10f40 4 
! c 2 10f47 2 e3 
! c 2 10f46 a defaultExe 
! c 3 10f49 1 
! c 2 54b6 2 e3 
! L 54b6 
! c 2 10f48 b executables 
! c 3 10f44 4 
! c 2 54bd 3 *.F 
! L 54bd 
! c 2 54c0 3 *.f 
! L 54c0 
! c 2 54c3 5 *.for 
! L 54c3 
! c 2 54c6 5 *.fpp 
! L 54c6 
! c 2 10f43 a extensions 
! c 2 10f42 7 Fortran 
! c 2 10f41 4 name 
! c 2 10e4b 7 Fortran 
! c 1 54db 
! c 0 10f86 4 
! c 2 10f8d 2 e3 
! c 2 10f8c a defaultExe 
! c 3 10f8f 1 
! c 2 54e8 2 e3 
! L 54e8 
! c 2 10f8e b executables 
! c 3 10f8a 2 
! c 2 54ef 3 *.H 
! L 54ef 
! c 2 54f2 3 *.h 
! L 54f2 
! c 2 10f89 a extensions 
! c 2 10f88 6 Header 
! c 2 10f87 4 name 
! c 2 10e4c 6 Header 
! c 1 5507 
! c 0 10fc4 4 
! c 2 10fcb 9 surfboard 
! c 2 10fca a defaultExe 
! c 3 10fcd 2 
! c 2 5514 2 e3 
! L 5514 
! c 2 5517 9 surfboard 
! L 5517 
! c 2 10fcc b executables 
! c 3 10fc8 2 
! c 2 551e 5 *.htm 
! L 551e 
! c 2 5521 6 *.html 
! L 5521 
! c 2 10fc7 a extensions 
! c 2 10fc6 4 Html 
! c 2 10fc5 4 name 
! c 2 10e4d 4 Html 
! c 1 5536 
! c 0 11006 4 
! c 2 1100d 2 e3 
! c 2 1100c a defaultExe 
! c 3 1100f 1 
! c 2 5543 2 e3 
! L 5543 
! c 2 1100e b executables 
! c 3 1100a 1 
! c 2 554a 6 *.java 
! L 554a 
! c 2 11009 a extensions 
! c 2 11008 4 Java 
! c 2 11007 4 name 
! c 2 10e4e 4 Java 
! c 1 555f 
! c 0 11040 4 
! c 2 11047 2 e3 
! c 2 11046 a defaultExe 
! c 3 11049 1 
! c 2 556c 2 e3 
! L 556c 
! c 2 11048 b executables 
! c 3 11044 1 
! c 2 5573 5 *.tex 
! L 5573 
! c 2 11043 a extensions 
! c 2 11042 5 Latex 
! c 2 11041 4 name 
! c 2 10e4f 5 Latex 
! c 1 5588 
! c 0 1107a 4 
! c 2 11081 2 e3 
! c 2 11080 a defaultExe 
! c 3 11083 1 
! c 2 5595 2 e3 
! L 5595 
! c 2 11082 b executables 
! c 3 1107e 0 
! c 2 1107d a extensions 
! c 2 1107c 5 Other 
! c 2 1107b 4 name 
! c 2 10e50 5 Other 
! c 2 10e45 a categories 
! c 0 10e52 1 
! C ProjectDir 4 55b2 
! c 2 55b3 28 netscript2/src/perl/NetScript/Libraries/ 11 81 
! c 2 55b4 0  0 
! c 2 10e54 28 netscript2/src/perl/NetScript/Libraries/ 
! c 2 10e51 b directories 
! C DmBag 5 10d04 6 
! c 2 10d3a eb b
! C DmDictionary 0 10d06 3 
! C DmString 1 10d18 36 b
! C DmSet 0 55f0 1 
! C DmString 1 561e 5 Other 
! L 561e  
! c 1 10d17 a categories 
! c 1 10d08 1b ControlStructuresLibrary.pm 
! c 1 10d07 4 name 
! C DmInteger 2 10d1a 1 
! c 1 10d19 9 substMode  
! c 2 10d6f de b
! C DmDictionary 0 10d3b 3 
! C DmString 1 10d4d 36 b
! C DmSet 0 562f 1 
! C DmString 1 565d 5 Other 
! L 565d  
! c 1 10d4c a categories 
! c 1 10d3d f DebugLibrary.pm 
! c 1 10d3c 4 name 
! C DmInteger 2 10d4f 1 
! c 1 10d4e 9 substMode  
! c 2 10da4 e1 b
! C DmDictionary 0 10d70 3 
! C DmString 1 10d82 36 b
! C DmSet 0 566e 1 
! C DmString 1 569c 5 Other 
! L 569c  
! c 1 10d81 a categories 
! c 1 10d72 11 DefaultLibrary.pm 
! c 1 10d71 4 name 
! C DmInteger 2 10d84 1 
! c 1 10d83 9 substMode  
! c 2 10dd9 e1 b
! C DmDictionary 0 10da5 3 
! C DmString 1 10db7 39 b
! C DmSet 0 10b73 1 
! C DmString 1 10ced 5 Other 
! L 10ced  
! c 1 10db6 a categories 
! c 1 10da7 f FormsLibrary.pm 
! c 1 10da6 4 name 
! C DmInteger 2 10db9 1 
! c 1 10db8 9 substMode  
! c 2 10e0e d9 b
! C DmDictionary 0 10dda 3 
! C DmString 1 10dec 36 b
! C DmSet 0 56ad 1 
! C DmString 1 56db 5 Other 
! L 56db  
! c 1 10deb a categories 
! c 1 10ddc a Library.pm 
! c 1 10ddb 4 name 
! C DmInteger 2 10dee 1 
! c 1 10ded 9 substMode  
! c 2 10e43 e3 b
! C DmDictionary 0 10e0f 3 
! C DmString 1 10e21 36 b
! C DmSet 0 56ec 1 
! C DmString 1 571a 5 Other 
! L 571a  
! c 1 10e20 a categories 
! c 1 10e11 13 VariablesLibrary.pm 
! c 1 10e10 4 name 
! C DmInteger 2 10e23 1 
! c 1 10e22 9 substMode  
! c 2 10e44 5 files 
! c 2 10d00 94 xterm -ls -fn -*-lucidatypewriter-medium-r-normal-*-12-* -bg gray90 -T Program -geometry 80x10+0+0 -e "[set command with 'Project->Launch Command']" 
! c 2 10cff 6 launch 
! c 2 10cfc 4 make 
! c 2 10cfb 4 make 
! c 2 10cfe 0  
! c 2 10cfd 8 makeFile 
! c 5 10d01 0 
! c 2 10d03 7 modules 
! c 2 10cfa 9 Libraries 
! c 2 10cf9 4 name 
--- 1,248 ----
  b
! C DmDictionary 0 d787 8 
! c 0 d90a 9 
! C Category 1 702b 
! c 0 d94a 4 
! C DmString 2 d951 2 e3 
! c 2 d950 a defaultExe 
! C DmSet 3 d953 1 
! c 2 703a 2 e3 
! L 703a 
! c 2 d952 b executables 
! c 3 d94e 3 
! c 2 7041 3 *.C 
! L 7041 
! c 2 7044 4 *.cc 
! L 7044 
! c 2 7047 5 *.cpp 
! L 7047 
! c 2 d94d a extensions 
! c 2 d94c a CPP_source 
! c 2 d94b 4 name 
! c 2 d90c a CPP_source 
! c 1 705c 
! c 0 d990 4 
! c 2 d997 2 e3 
! c 2 d996 a defaultExe 
! c 3 d999 1 
! c 2 7069 2 e3 
! L 7069 
! c 2 d998 b executables 
! c 3 d994 1 
! c 2 7070 3 *.c 
! L 7070 
! c 2 d993 a extensions 
! c 2 d992 8 C_source 
! c 2 d991 4 name 
! c 2 d90d 8 C_source 
! c 1 7085 
! c 0 d9ca 4 
! c 2 d9d1 2 e3 
! c 2 d9d0 a defaultExe 
! c 3 d9d3 1 
! c 2 7092 2 e3 
! L 7092 
! c 2 d9d2 b executables 
! c 3 d9ce 1 
! c 2 7099 3 *.e 
! L 7099 
! c 2 d9cd a extensions 
! c 2 d9cc 6 Eiffel 
! c 2 d9cb 4 name 
! c 2 d90e 6 Eiffel 
! c 1 70ae 
! c 0 da04 4 
! c 2 da0b 2 e3 
! c 2 da0a a defaultExe 
! c 3 da0d 1 
! c 2 70bb 2 e3 
! L 70bb 
! c 2 da0c b executables 
! c 3 da08 4 
! c 2 70c2 3 *.F 
! L 70c2 
! c 2 70c5 3 *.f 
! L 70c5 
! c 2 70c8 5 *.for 
! L 70c8 
! c 2 70cb 5 *.fpp 
! L 70cb 
! c 2 da07 a extensions 
! c 2 da06 7 Fortran 
! c 2 da05 4 name 
! c 2 d90f 7 Fortran 
! c 1 70e0 
! c 0 da4a 4 
! c 2 da51 2 e3 
! c 2 da50 a defaultExe 
! c 3 da53 1 
! c 2 70ed 2 e3 
! L 70ed 
! c 2 da52 b executables 
! c 3 da4e 2 
! c 2 70f4 3 *.H 
! L 70f4 
! c 2 70f7 3 *.h 
! L 70f7 
! c 2 da4d a extensions 
! c 2 da4c 6 Header 
! c 2 da4b 4 name 
! c 2 d910 6 Header 
! c 1 710c 
! c 0 da88 4 
! c 2 da8f 9 surfboard 
! c 2 da8e a defaultExe 
! c 3 da91 2 
! c 2 7119 2 e3 
! L 7119 
! c 2 711c 9 surfboard 
! L 711c 
! c 2 da90 b executables 
! c 3 da8c 2 
! c 2 7123 5 *.htm 
! L 7123 
! c 2 7126 6 *.html 
! L 7126 
! c 2 da8b a extensions 
! c 2 da8a 4 Html 
! c 2 da89 4 name 
! c 2 d911 4 Html 
! c 1 713b 
! c 0 daca 4 
! c 2 dad1 2 e3 
! c 2 dad0 a defaultExe 
! c 3 dad3 1 
! c 2 7148 2 e3 
! L 7148 
! c 2 dad2 b executables 
! c 3 dace 1 
! c 2 714f 6 *.java 
! L 714f 
! c 2 dacd a extensions 
! c 2 dacc 4 Java 
! c 2 dacb 4 name 
! c 2 d912 4 Java 
! c 1 7164 
! c 0 db04 4 
! c 2 db0b 2 e3 
! c 2 db0a a defaultExe 
! c 3 db0d 1 
! c 2 7171 2 e3 
! L 7171 
! c 2 db0c b executables 
! c 3 db08 1 
! c 2 7178 5 *.tex 
! L 7178 
! c 2 db07 a extensions 
! c 2 db06 5 Latex 
! c 2 db05 4 name 
! c 2 d913 5 Latex 
! c 1 718d 
! c 0 db3e 4 
! c 2 db45 2 e3 
! c 2 db44 a defaultExe 
! c 3 db47 1 
! c 2 719a 2 e3 
! L 719a 
! c 2 db46 b executables 
! c 3 db42 0 
! c 2 db41 a extensions 
! c 2 db40 5 Other 
! c 2 db3f 4 name 
! c 2 d914 5 Other 
! c 2 d909 a categories 
! c 0 d916 1 
! C ProjectDir 4 71b7 
! c 2 71b8 28 netscript2/src/perl/NetScript/Libraries/ 11 81 
! c 2 71b9 0  0 
! c 2 d918 28 netscript2/src/perl/NetScript/Libraries/ 
! c 2 d915 b directories 
! C DmBag 5 d793 7 
! c 2 d7c9 d7 b
! C DmDictionary 0 d795 3 
! C DmString 1 d7a7 36 b
! C DmSet 0 d602 1 
! C DmString 1 d77c 5 Other 
! L d77c  
! c 1 d7a6 a categories 
! c 1 d797 f ClassLibrary.pm 
! c 1 d796 4 name 
! C DmInteger 2 d7a9 1 
! c 1 d7a8 9 substMode  
! c 2 d7fe e4 b
! C DmDictionary 0 d7ca 3 
! C DmString 1 d7dc 36 b
! C DmSet 0 71f7 1 
! C DmString 1 7225 5 Other 
! L 7225  
! c 1 d7db a categories 
! c 1 d7cc 1b ControlStructuresLibrary.pm 
! c 1 d7cb 4 name 
! C DmInteger 2 d7de 1 
! c 1 d7dd 9 substMode  
! c 2 d833 d7 b
! C DmDictionary 0 d7ff 3 
! C DmString 1 d811 36 b
! C DmSet 0 7236 1 
! C DmString 1 7264 5 Other 
! L 7264  
! c 1 d810 a categories 
! c 1 d801 f DebugLibrary.pm 
! c 1 d800 4 name 
! C DmInteger 2 d813 1 
! c 1 d812 9 substMode  
! c 2 d868 da b
! C DmDictionary 0 d834 3 
! C DmString 1 d846 36 b
! C DmSet 0 7275 1 
! C DmString 1 72a3 5 Other 
! L 72a3  
! c 1 d845 a categories 
! c 1 d836 11 DefaultLibrary.pm 
! c 1 d835 4 name 
! C DmInteger 2 d848 1 
! c 1 d847 9 substMode  
! c 2 d89d d7 b
! C DmDictionary 0 d869 3 
! C DmString 1 d87b 36 b
! C DmSet 0 72b4 1 
! C DmString 1 72e2 5 Other 
! L 72e2  
! c 1 d87a a categories 
! c 1 d86b f FormsLibrary.pm 
! c 1 d86a 4 name 
! C DmInteger 2 d87d 1 
! c 1 d87c 9 substMode  
! c 2 d8d2 d2 b
! C DmDictionary 0 d89e 3 
! C DmString 1 d8b0 36 b
! C DmSet 0 72f3 1 
! C DmString 1 7321 5 Other 
! L 7321  
! c 1 d8af a categories 
! c 1 d8a0 a Library.pm 
! c 1 d89f 4 name 
! C DmInteger 2 d8b2 1 
! c 1 d8b1 9 substMode  
! c 2 d907 dc b
! C DmDictionary 0 d8d3 3 
! C DmString 1 d8e5 36 b
! C DmSet 0 7332 1 
! C DmString 1 7360 5 Other 
! L 7360  
! c 1 d8e4 a categories 
! c 1 d8d5 13 VariablesLibrary.pm 
! c 1 d8d4 4 name 
! C DmInteger 2 d8e7 1 
! c 1 d8e6 9 substMode  
! c 2 d908 5 files 
! c 2 d78f 94 xterm -ls -fn -*-lucidatypewriter-medium-r-normal-*-12-* -bg gray90 -T Program -geometry 80x10+0+0 -e "[set command with 'Project->Launch Command']" 
! c 2 d78e 6 launch 
! c 2 d78b 4 make 
! c 2 d78a 4 make 
! c 2 d78d 0  
! c 2 d78c 8 makeFile 
! c 5 d790 0 
! c 2 d792 7 modules 
! c 2 d789 9 Libraries 
! c 2 d788 4 name 

[NetScript CVS] CVS: netscript2/src/perl/NetScript/Engine Class.pm,1.5,1.6 DOMWalker.pm,1.7,1.8 Function.pm,1.1,1.2 Member.pm,1.1,1.2 MemberWrapper.pm,1.1,1.2 State.pm,1.6,1.7 StatementEvaluator.pm,1.9,1.10

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

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

Modified Files:
	Class.pm DOMWalker.pm Function.pm Member.pm MemberWrapper.pm 
	State.pm StatementEvaluator.pm 
Log Message:
* added support for classes and methods
* did a complete rewrite of the variable system
* various bugfixes

Index: Class.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/Class.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** Class.pm	29 May 2002 20:26:17 -0000	1.5
--- Class.pm	11 Jul 2002 22:03:09 -0000	1.6
***************
*** 40,43 ****
--- 40,58 ----
      }
  
+ #/**
+ # Sets the name of the class
+ #*/
+ sub setName {
+     my ( $this, $name ) = @_;
+     $this -> { m_Name } = $name;
+     }
+ 
+ #/**
+ # Returns the name of the class.
+ #*/
+ sub getName {
+     my ( $this, $name ) = @_;
+     $this -> { m_Name };
+     }
  
  #/**
***************
*** 46,50 ****
  # @return an instance of NetScript::Engine::Function
  #*/
! sub function {
      my ($this, $name ) = @_;
      $this -> { m_Functions } -> { $name };
--- 61,65 ----
  # @return an instance of NetScript::Engine::Function
  #*/
! sub getFunction {
      my ($this, $name ) = @_;
      $this -> { m_Functions } -> { $name };
***************
*** 57,61 ****
  sub setFunction {
      my ($this, $function ) = @_;
!     $this -> { m_Functions } -> { $function -> name() } = $function;
      $function -> setParent( $this );
      }
--- 72,76 ----
  sub setFunction {
      my ($this, $function ) = @_;
!     $this -> { m_Functions } -> { $function -> getName() } = $function;
      $function -> setParent( $this );
      }
***************
*** 67,73 ****
  # @return an instance NetScript::Engine::Member
  #*/
! sub member {
      my ($this, $name) = @_;
!     $this -> { m_Functions } -> { $name };
      }
  
--- 82,88 ----
  # @return an instance NetScript::Engine::Member
  #*/
! sub getMember {
      my ($this, $name) = @_;
!     $this -> { m_Members } -> { $name };
      }
  
***************
*** 78,86 ****
  sub setMember {
      my ($this, $member) = @_;
!     $this -> { m_Members } -> { $member -> name() } = $member;
      $member -> setParent( $this );
      }
  
  
  #/**
  # Returns a reference to an array holding all functions
--- 93,103 ----
  sub setMember {
      my ($this, $member) = @_;
!     $this -> { m_Members } -> { $member -> getName() } = $member;
      $member -> setParent( $this );
      }
  
  
+ 
+ 
  #/**
  # Returns a reference to an array holding all functions
***************
*** 94,97 ****
--- 111,123 ----
  
  #/**
+ # Returns a list reference of all functions of this class.
+ #*/
+ sub functionsList {
+     my ( $this ) = @_;
+     my @functions = values( %{ $this -> { m_Functions } } );
+     return \@functions;
+     }
+ 
+ #/**
  # Returns a reference to an array holding all members 
  # defined in this class
***************
*** 101,104 ****
--- 127,139 ----
      my ( $this ) = @_;
      $this -> { m_Members };
+     }
+ 
+ #/**
+ # Returns a list reference of all members of this class
+ #*/
+ sub membersList {
+     my ( $this ) = @_;
+     my @members = values( %{ $this -> { m_Members } } );
+     return \@members;
      }
  

Index: DOMWalker.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/DOMWalker.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** DOMWalker.pm	7 Jul 2002 14:34:31 -0000	1.7
--- DOMWalker.pm	11 Jul 2002 22:03:09 -0000	1.8
***************
*** 280,284 ****
      
       while ( $this -> currentSource() ) {
- warn "I'm walking: ". $this -> currentSource();
           $this -> createEvent( $this -> currentSource() );
           }
--- 280,283 ----

Index: Function.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/Function.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Function.pm	29 May 2002 20:26:17 -0000	1.1
--- Function.pm	11 Jul 2002 22:03:09 -0000	1.2
***************
*** 32,45 ****
      my $this = {};
      bless( $this, $class );             # create Object
!     $this -> { m_Parent } = $parent;      # parent class
      return $this;                       # return Object
      }
  
  
  #/**
  # Returns the parent class of this sub.
  # @return an instance of <code>NetScript::Engine::Class</code>
  #*/
! sub parent {
      my ( $this )  = @_;
      $this -> { m_Parent };
--- 32,67 ----
      my $this = {};
      bless( $this, $class );             # create Object
!     my @valueParameters = ();
!     my @referenceParameters = ();
!     $this -> { m_Name } = "";
!     $this -> { m_Parent } = $parent;    # parent class
!     $this -> { m_Code } = undef;        # executable code
!     $this -> { m_valParams } = \@valueParameters;
!     $this -> { m_refParams } = \@referenceParameters;
      return $this;                       # return Object
      }
  
+ #/**
+ # Sets the name of this function.
+ #*/
+ sub setName {
+     my ( $this, $name ) = @_;
+     $this -> { m_Name } = $name;
+     }
+ 
+ #/**
+ # Returns the name of this function.
+ #*/
+ sub getName {
+     my ( $this ) = @_;
+     $this -> { m_Name };
+     }
  
  #/**
  # Returns the parent class of this sub.
  # @return an instance of <code>NetScript::Engine::Class</code>
+ # @public
  #*/
! sub getParent {
      my ( $this )  = @_;
      $this -> { m_Parent };
***************
*** 49,52 ****
--- 71,75 ----
  # Sets the parent class of this sub.
  # @param an instance of <code>NetScript::Engine::Class</code>
+ # @public
  #*/
  sub setParent {
***************
*** 55,65 ****
      }
  
  #/**
! # Invokes this sub. A list of parameters is given as argument
! # @optional one or more parameters 
! # @not-implemented
  #*/
! sub invoke {
!     
      }
  
--- 78,142 ----
      }
  
+ 
  #/**
! # Sets the Code which is executed when calling the function.
! # @param an instance of XML::DOM2::Node or one of its subclasses.
! # @public
  #*/
! sub setCode {
!     my ( $this, $code ) = @_;
!     $this -> { m_Code } = $code;
!     }
! 
! #/**
! # Returns the Code which has to be executed when calling the function.
! # @return an instance of XML::DOM2::Node
! #*/
! sub getCode {
!     my ( $this ) = @_;
!     my $code = $this -> { m_Code };
!     return $code;
!     }
! 
! #/**
! # Sets all parameters of this function which are given by value
! # @optional any number of parameters
! # @public
! #*/
! sub setValueParameters {
!     my ( $this, @params )  = @_;
!     @{$this -> { m_valParams }} = @params;
!     }
! 
! #/**
! # Returns an array reference to an array holding the names
! # of all parameters of this functions which are given by value.
! # @return an array reference
! # @public
! #*/
! sub getValueParameters {
!     my ( $this ) = @_;
!     $this -> { m_valParams };
!     }
! 
! #/**
! # Sets all parameters of this function which are given by reference
! # @optional any number of parameters
! # @public
! #*/
! sub setReferenceParameters {
!     my ( $this, @params )  = @_;
!     @{$this -> { m_refParams }} = @params;
!     }
! 
! #/**
! # Returns an array reference to an array holding the names
! # of all parameters of this functions which are given by reference.
! # @return an array reference
! # @public
! #*/
! sub getReferenceParameters {
!     my ( $this ) = @_;
!     $this -> { m_refParams };
      }
  

Index: Member.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/Member.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Member.pm	29 May 2002 20:26:17 -0000	1.1
--- Member.pm	11 Jul 2002 22:03:09 -0000	1.2
***************
*** 41,45 ****
  # @return an instance of <code>NetScript::Engine::Class</code>
  #*/
! sub parent {
      my ( $this )  = @_;
      $this -> { m_Parent };
--- 41,45 ----
  # @return an instance of <code>NetScript::Engine::Class</code>
  #*/
! sub getParent {
      my ( $this )  = @_;
      $this -> { m_Parent };
***************
*** 58,62 ****
  # Returns the value of this member
  #*/
! sub value {
      my ( $this ) = @_;
      $this -> { m_Value };
--- 58,62 ----
  # Returns the value of this member
  #*/
! sub getValue {
      my ( $this ) = @_;
      $this -> { m_Value };
***************
*** 70,73 ****
--- 70,91 ----
      my ( $this, $value ) = @_;
      $this -> { m_Value } = $value;
+     }
+ 
+ #/**
+ # Sets the name of the member.
+ # @param a scalar holding the name of this member
+ #*/
+ sub setName {
+     my ( $this, $name ) = @_;
+     $this -> { m_Name } = $name;
+     }
+ 
+ #/**
+ # Returns the name of this member object.
+ # @return a scalar holding a name
+ #*/
+ sub getName {
+     my ( $this ) = @_;
+     $this -> { m_Name };
      }
  

Index: MemberWrapper.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/MemberWrapper.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** MemberWrapper.pm	2 Jun 2002 19:31:23 -0000	1.1
--- MemberWrapper.pm	11 Jul 2002 22:03:09 -0000	1.2
***************
*** 57,61 ****
  # Returns the value of this member
  #*/
! sub value {
      my ( $this ) = @_;
      my $sub = $this -> { m_SubOnRetrieval };
--- 57,61 ----
  # Returns the value of this member
  #*/
! sub getValue {
      my ( $this ) = @_;
      my $sub = $this -> { m_SubOnRetrieval };

Index: State.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/State.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** State.pm	9 Jun 2002 12:50:04 -0000	1.6
--- State.pm	11 Jul 2002 22:03:09 -0000	1.7
***************
*** 38,52 ****
      $this -> { m_ParentState } = undef;
      my %variables = ();
-     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.
--- 38,42 ----
***************
*** 104,156 ****
      }        
  
- #/**
- # Checks if the array exists in current state. If not
- # the check will be performed on the parent state. 
- # @param a string containing the array name
- # @return a reference to the State which holds the array
- #   or undef, if the array is currently not known.
- #*/
- sub arrayExists {
-     my ($this, $array) = @_;
-     my $parent = $this -> { m_ParentState };
-     my $result = $this -> { m_Arrays } -> {$array};
-     
-     # check if array exists in this state
-     if ( !defined( $result ) ) {    # no it doesn't
-         if ( defined( $parent ) ) { # check for parent state
-             # try to get it from there
-             return $parent -> arrayExists( $array );
-             }
-         # no more parent state, so the array does not exist.
-         return undef;
-         }
-     # array exists in this state so return yourself.
-     return $this;       
-     }        
- 
- #/**
- # Checks if the object exists in current state. If not
- # the check will be performed on the parent state. 
- # @param a string containing the object name
- # @return a reference to the State which holds the object
- #   or undef, if the object is currently not known.
- #*/
- sub objectExists {
-     my ($this, $object) = @_;
-     my $parent = $this -> { m_ParentState };
-     my $result = $this -> { m_Objects } -> {$object};
-     
-     # check if object exists in this state
-     if ( !defined( $result ) ) {    # no it doesn't
-         if ( defined( $parent ) ) { # check for parent state
-             # try to get it from there
-             return $parent -> objectExists( $object );
-             }
-         # no more parent state, so the object does not exist.
-         return undef;
-         }
-     # object exists in this state so return yourself.
-     return $this;       
-     }
  
  #/**
--- 94,97 ----
***************
*** 219,381 ****
      } 
          
- #/**
- # Sets the value of the given array entry. Array is 
- # 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 array name.
- # @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 {
-     my ($this, $array, $index, $value) = @_;
-     
-     # check if a parent state already knows this 
-     # array
-     my $variableHolder = $this -> arrayExists( $array );
-     
-     if (defined( $variableHolder ) && $variableHolder != $this) {   
-         # 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;
- 
-     }
- 
-     
- #/**
- # Returns the value of the given array at the given index. If this state 
- # does not contain the array, parent states will be checked until the 
- # array is found there, or the topmost state is reached.
- # @param a string containing the name of the array to look up.
- # @param a scalar containing the index of the array to look up.
- # @return a scalar holding the value of the variable or undef, if the
- #   variable is not defined.
- #*/
- sub getArrayValue {
-     my ( $this, $array, $index ) = @_;
-     
-     my $variableHolder = $this -> arrayExists( $array );
-     if ( defined( $variableHolder ) ) {
-         return $variableHolder -> { m_Arrays } -> { $array } -> [$index];
-         }
-     return undef;
-     } 
- 
- #/**
- # Returns the largest index of the given array or undef, if no such
- # 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 {
-     my ( $this, $array ) = @_;
-     my $variableHolder = $this -> arrayExists( $array );
-     if ( defined( $variableHolder ) ) {
-         return scalar( @{$variableHolder -> { m_Arrays } -> { $array }} )-1;
-         }
-     undef;
-     } 
-     
- #/**
- # 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 value could be set, zero if the object
- #   didn't exist.
- # 
- #*/
- sub setObjectValue {
-     my ($this, $object, $value) = @_;
-     
-     # check if a parent state already knows this 
-     # object
-     my $variableHolder = $this -> objectExists( $object );
-     
-     if (defined( $variableHolder ) && $variableHolder != $this) {   
-         # 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;
-     }
-     
- #/**
- # Returns the value of the given object . If this state 
- # does not contain the object, parent states will be checked until the 
- # object is found there, or the topmost state is reached.
- # @param a string containing the name of the object to look up.
- # @return a scalar holding the object or undef, if the
- #   object is not defined.
- #*/
- sub getObjectValue {
-     my ( $this, $object ) = @_;
-     
-     my $variableHolder = $this -> objectExists( $object );
-     if ( defined( $variableHolder ) ) {
-         return $variableHolder -> { m_Objects } -> { $object };
-         }
-     return undef;
-     } 
  
  
--- 160,163 ----

Index: StatementEvaluator.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Engine/StatementEvaluator.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** StatementEvaluator.pm	7 Jul 2002 14:34:31 -0000	1.9
--- StatementEvaluator.pm	11 Jul 2002 22:03:09 -0000	1.10
***************
*** 14,19 ****
  package NetScript::Engine::StatementEvaluator;
  
- 
- 
  use NetScript::Interpreter;
  use NetScript::Libraries::DebugLibrary;
--- 14,17 ----
***************
*** 78,98 ****
              $param =~ s/\\\)/\)/g;
              
!             # find a first dot representing a class
!             if ( $param =~/^(.*?)\.(.*)$/ ) {
                  $action = $1;
                  $param = $2;
                  }
!         
!             
              if ( $pref =~ /^(.*?[^\\]?)\$$/ ) {
                  $pref = $1;
                  # now evaluate the action and generate a result.
                  if ($action eq '' ) { # a variable or array statement
!                     if ($param =~ /^([^:]+):(.*)$/) { # array statement
!                         $result = $this -> getArrayValue($1, $2);
!                         }
!                     else {
!                         $result = $this -> getVariableValue( $param );
!                     }
                      }
                  elsif ($action eq 'eval' || $action eq '?' ) { # an eval-statement
--- 76,92 ----
              $param =~ s/\\\)/\)/g;
              
!            
!             # lookup builtin functions ( format is $(name[parameter]) )
!             if ( $param =~ /^(.+) *\[(.*)\]$/ ) {
                  $action = $1;
                  $param = $2;
                  }
! 
              if ( $pref =~ /^(.*?[^\\]?)\$$/ ) {
                  $pref = $1;
+ 
                  # now evaluate the action and generate a result.
                  if ($action eq '' ) { # a variable or array statement
!                     $result = $this -> resolveObjectValue( $param );
                      }
                  elsif ($action eq 'eval' || $action eq '?' ) { # an eval-statement
***************
*** 106,111 ****
                      }
                  else {
!                     # return the member value of the given object
!                     $result = $this -> getMember( $action, $param );
                      }
                  }
--- 100,104 ----
                      }
                  else {
!                     # XXX: Problem unknown statement
                      }
                  }
***************
*** 126,210 ****
      }
   
- 
  #/**
! # Returns the value of a variable.
! # @param the name of the variable
  # @protected
  #*/
! sub getVariableValue {
!     my ($this, $variable) = @_;
!     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;
      }
  
  #/**
! # Returns the value of the array with the given index.
! # @param the name of the array
! # @param the index within the array
! # @protected
  #*/
! sub getArrayValue {
!     my ($this, $array, $index) = @_;
!     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;
      }
  
  #/**
! # Returns the largest valid index in the given array.
! # @param the name of the array
! # @protected
  #*/
! sub getLargestArrayIndex {
!     my ( $this, $array ) = @_;
!     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;            
-     }
  
! #/**
! # Returns the member of the given object.
! # @param the name of the object
! # @param the name of the member
! #*/
! 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();
      }
  
  #/**
  # Creates the given variable (array).
--- 119,235 ----
      }
   
  #/**
! # Returns the largest valid index in the given array.
! # @param the name of the array
  # @protected
  #*/
! sub getLargestArrayIndex {
!     my ( $this, $array ) = @_;
!     my $result = $this -> resolveObject( $array );
!     return scalar( @{ $result -> getValue() } ) -1;
      }
  
  #/**
! # Resolves the value of a given object.
! # @param the name of the object to resolve.
! # @return the value of the resolved object.
  #*/
! sub resolveObjectValue {
!     my ( $this, $toResolve ) = @_;
!     my $object = $this -> resolveObject( $toResolve );
!     return $object -> getValue();
      }
  
  #/**
! # Resolves the given object. 
! # @param the name of the object
! # @param an instance of NetScript::Engine::Member
! # @param a boolean if nonzero no fatal events will be thrown if the
! #       lookup fails.
  #*/
! sub resolveObject {
!     my ( $this, $toResolve, $quiet ) = @_;
!     my $fqName = $toResolve;
  
!     # check if there is point within it, so we divide the string here
!     my $objectName = "";
!     if ( $toResolve =~ /^([^\.]+)\.(.*)$/ ) {
!         $objectName = $1;
!         $toResolve = $2;
!         }
!     else {
!         $objectName = $toResolve;
!         $toResolve = "";
          }
  
!     my $index = -1;
!     # check for array
!     if ( $objectName =~ /^([^:]+):([0-9]+)$/ ) {
!         $objectName = $1;
!         $index = $2;
!         }
! 
!     # get object
      my $object = $this -> interpreter() -> getState() ->
!         getVariableValue( $objectName );
! 
!     # check for existence
!     unless ( defined( $object ) ) {
!         unless( $quiet ) {
!             $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
!                     $NetScript::Interpreter::FATAL_EVENT,
!                     "There is no object named \"$objectName\"." );
!             }        
!         return undef;
          }
! 
!     # continue until all is resolved
!     while ( $toResolve =~ /^([^\.]+)\.?(.*)$/ ) {
!         my $memberName = $1;
!         $toResolve = $2;
! 
!         # we got a MEMBER in $object, so we now extract its value
!         # which must be a CLASS
!         if ( $index != -1 ) {
!             $object = $object -> getValue() -> [ $index ] -> getValue(); # is an array
!             }
!         else {
!             $object = $object -> getValue(); #is no array
!             }
! 
!         $index = -1;
!         if ( $memberName =~ /^([^:])+:([0-9]+)$/ ) {
!             $memberName = $1;
!             $index = $2;
!             }
! 
!         my $oldObject = $object;
!         if ( UNIVERSAL::isa( $object, "NetScript::Engine::Class" ) ) {
!             $object = $object -> getMember( $memberName );
!             }
!        
!         unless( defined( $object ) ) {
!             unless ( $quiet ) {
!                 $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
!                         $NetScript::Interpreter::FATAL_EVENT,
!                         "Cannot resolve $toResolve since $memberName is no member of " . $oldObject -> getName() );
!                 }
!             return undef;
!             }
          }
!     
!     unless ( defined( $object ) ) {
!         unless ( $quiet ) {
!             $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
!                     $NetScript::Interpreter::FATAL_EVENT,
!                     "Cannot resolve $fqName." );
!             }
!         return undef;
!         }
!     
!     return $object;
      }
  
+ 
  #/**
  # Creates the given variable (array).
***************
*** 215,238 ****
      my ( $this, $name, $value ) = @_;
  
      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
--- 240,286 ----
      my ( $this, $name, $value ) = @_;
  
+     # check if variable name is correct.
+     if ( $name =~/[^a-zA-Z0-9_]/ ) {
+         $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
+                 $NetScript::Interpreter::FATAL_EVENT,
+                 "Illegal variable name \"$name\"!" );
+         return;
+         }
+     # check if variable to create is 
      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;
              }
+         my @newArray = ();
+         my $valueMember = NetScript::Engine::Member -> new();
+         $valueMember -> setValue( $value );
+         $newArray[$2] = $valueMember; # set value
+         my $arrayMember = NetScript::Engine::Member -> new();
+         $arrayMember -> setName( $1 );
+         $arrayMember -> setValue( \@newArray );
+         $this -> interpreter() -> getState() -> createVariableValue( $1, $arrayMember);
          }
      else {
!         my $object = $this -> resolveObject( $name, 1 ); #quiet!
!         if ( defined( $object )  ) {
              $this -> interpreter() -> getEventRelay() -> createAndRaiseEvent(
                      $NetScript::Interpreter::FATAL_EVENT,
                      "A variable named \"$name\" already exists!" );
+             return;
              }
+         my $var = NetScript::Engine::Member -> new();
+         $var -> setName( $name );
+         $var -> setValue( $value );
+         $this -> interpreter() -> getState() ->
+                 createVariableValue( $name, $var );
          }
      }
  
  #/**
! # Sets the given variable
  # @param string describing the variable name
  # @param string holding the variable value
***************
*** 241,259 ****
      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!" );
!             }
          }
      }
--- 289,305 ----
      my ( $this, $name, $value ) = @_;
  
! 
!     if ( $name =~ /^(.*):([0-9]+)$/ ) { # its an array
!         
!         my $arrayName = $1;        
!         my $index = $2;
!         my $array = $this -> resolveObject( $1 );
!         my $member = NetScript::Engine::Member -> new();
!         $member -> setValue( $value );
!         $array -> getValue() -> [ $index ] = $member;
          }
      else {
!         my $member = $this -> resolveObject( $name );
!         $member -> setValue( $value );
          }
      }
***************
*** 267,284 ****
      }
  
- #/**
- # Sends a debug event.
- # @param the debug message
- # @private
- #*/
- sub debug {
-     my ($this, $message) = @_;
-     $this -> interpreter() -> getEventRelay() ->
-             createAndRaiseEvent( 
-             $NetScript::Libraries::DebugLibrary::DEBUG_EVENT,
-             $message,
-             "Control" 
-             );
-     }
  
  1; # make "require" happy    
--- 313,316 ----