[NetScript CVS] CVS: netscript2/src/perl/NetScript/Util ClassWrapper.pm,NONE,1.1 FunctionWrapper.pm,NONE,1.1 MemberWrapper.pm,NONE,1.1

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

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

Added Files:
	ClassWrapper.pm FunctionWrapper.pm MemberWrapper.pm 
Log Message:
* added wrappers for function, class and member, allowing libraries to create on-the-fly-objects

--- NEW FILE: ClassWrapper.pm ---
#--------------------------------------------------------
# $Id: ClassWrapper.pm,v 1.1 2002/05/29 20:28:48 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 class is a wrapper around a class object.
# It is used by libraries which want to create objects at
# runtime, without creating a class for it.
#*/
package NetScript::Util::ClassWrapper;
use base qw(NetScript::Engine::Class);


use NetScript::Util::FunctionWrapper;
use NetScript::Util::MemberWrapper;

#--------------------------------------------------------
# Globals
#--------------------------------------------------------


#/**
# Ctor.
# @param an object that should be wrapped and being represented
# as a class.
#*/
sub new {
    my ($proto, $object) = @_;
    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
    }


#/**
# Sets the given function. A FunctionWrapper will be
# created for the given function name. If this function
# is invoked, the given sub on the wrapped object will be called.
# @param the name of the function to create
# @param the name of the sub which should be called upon invocation
# of the function.
#*/
sub setFunction {
    my ($this, $function, $subToCall ) = @_;
    my $wrapper = NetScript::Util::FunctionWrapper -> new( 
        $this -> object(), $function, $subToCall );
    $this -> functions() -> { $function } = $wrapper;
    }

#/**
# Sets the given member. A MemberWrapper will be created.
# The given subs will be called upon setting and retrieval
# of the given member. The given subs will be called with
# two parameters. The first one is the member name actually
# used, the second is the new member value (in case of setting
# or undef in case of retrieval).
# @param a regexp matching a member name
# @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.
# @public
#*/
sub setMember {
    my ($this, $member, $subOnSetting, $subOnRetrieval ) = @_;
    my $memberWrapper = NetScript::Util::MemberWrapper -> new( $this,
        $this  -> object(), $subOnSetting, $subOnRetrieval );
    $this -> members() -> { $member } = $memberWrapper;
    }


sub member {
    my ( $this, $member ) = @_;
    for ( keys( %{$this -> members() } ) ) {
        if ( $member =~ /$_/ ) { # if the given member name matches an regexp
            my $memberObject = $this -> members() -> { $_ } -> clone();
            $memberObject -> setName( $member );
            return $memberObject;
            }
        }
    return undef;
    }

#/**
# Returns the wrapped object.
# @private
#*/
sub object {
    my ( $this ) = @_;
    $this -> { m_Object };
    }

1; # make "require" happy    

--- NEW FILE: FunctionWrapper.pm ---
#--------------------------------------------------------
# $Id: FunctionWrapper.pm,v 1.1 2002/05/29 20:28:48 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 class represents a Function. It wraps around an object
# and calls a sub upon invocation of the function.
#*/
package NetScript::Util::FunctionWrapper;
use base qw(NetScript::Engine::Function);


#--------------------------------------------------------
# Globals
#--------------------------------------------------------


#/**
# 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    

--- NEW FILE: MemberWrapper.pm ---
#--------------------------------------------------------
# $Id: MemberWrapper.pm,v 1.1 2002/05/29 20:28:48 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 class represents a Member. It wraps around an
# object and calls methods of the wrapped object 
# on setting and retrieval of member values.
# @public
#*/
package NetScript::Util::MemberWrapper;
use base qw(NetScript::Engine::Member);


#--------------------------------------------------------
# Globals
#--------------------------------------------------------


#/**
# Ctor.
# @param the parent class object
# @param the object on which the subs should be called
# @param a sub that should be called upon member setting
# @param a sub that should be called upon member retrieval
#*/
sub new {
    my ($proto, $parent, $object, $subOnSetting, $subOnRetrieval ) = @_;
    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;
    $this -> { m_SubOnRetrieval } = $subOnRetrieval;
    $this -> { m_Object } = $object;
    return $this;                       # return Object
    }

#/**
# Sets the name of this member.
# @protected.
#*/
sub setName {
    my ( $this, $name ) = @_;
    $this -> { m_Name } = $name;
    }


#/**
# Returns the value of this member
#*/
sub value {
    my ( $this ) = @_;
    my $sub = $this -> { m_SubOnRetrieval };
    $this -> { m_Object } -> $sub ( $this -> { m_Name } );
    }

#/**
# Sets the value of this member.
# @param a scalar holding the value of this member.
#*/
sub setValue {
    my ( $this, $value ) = @_;
    my $sub = $this -> { m_SubOnSetting };
    $this -> { m_Object } -> $sub( $this -> { m_Name }, $value );
    }

#/**
# Creates a clone of this wrapper.
# @return an instance of NetScript::Util::MemberWrapper.
# @protected 
#*/
sub clone {
    my ( $this ) = @_;
    my $clone = NetScript::Util::MemberWrapper -> new (
        $this -> parent(), $this -> { m_Object },
        $this -> { m_SubOnSetting }, $this -> { m_SubOnRetrieval }
        );
    $clone;    
    }

1; # make "require" happy