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

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

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/Libraries DatabaseLibrary.pm,NONE,1.1 ClassLibrar

[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