Menu
▾
▴
[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
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 ----
|
