Re: Qn on classes, inheritance, and threads

Williamawalters Wed, 29 Mar 2006 03:02:24 -0800

In a message dated 3/28/2006 10:57:40 P.M. Eastern Standard Time, [EMAIL PROTECTED] writes:

> Hey William,
>
> Ok, I've dug around, and I've got a working solution to my problem. It's
> a bit ugly though:
>
> package BaseClass;
> ...
> sub doThis
> {
>     my $pFunc;
>     eval '$pFunc = \&'.ref($this).'::doThat';
>     return threads->new($pFunc,$this);
> }
>
> package DerivedClass;
> ...
> sub doThat
> {
> ...
> }
>
> Essentially, the 3 lines of code does the following:
> 1. ref($this) returns the class name
> 2. eval is needed to get the pointer to the instance's overloaded class
> subroutine, and store it in $pFunc
> 3. use $pFunc directly as a parameter in new()
>
> My question is: is there a cleaner way to do this: ie without the use of
> eval?

hi ji-haw --

(btw -- i hope the above form of address is proper. if it is not, or if you would

prefer something else, please let me know.)

i think it should be possible to avoid the use of eval() in your code by using

``soft'' references to subroutines. see some examples below to give you some ideas.

however, although i'm not confident i understand just what you're doing, it seems

to me there would be an even cleaner way to handle things by re-organizing the

structure of the object being created so that it would include a hard reference to

the function at issue. (see amended -- and untested -- code below; look for the

####s for changes.) by doing this, the need for a method in one class to ``know''

the name of and directly reference a method in another class is eliminated.

remember, it was too much knowledge that got adam and eve thrown out of the

garden of eden!

hth -- bill walters

-----------------------begin code ---------------------------

#### tested code

use strict;
use warnings;

package Foo;

sub foo { my $message = shift; print qq(i am in foo: $message \n) }

package main;

# ``direct'' invocation
Foo::foo(1);
# &{Foo::foo}(2); # 'ambiguous use...' warning - not sure why

no strict 'refs'; # allow use of ``soft'' subroutine references

&{'Foo::foo'}(3);
'Foo::foo'->(4);

my $soft_foo = 'Foo::foo';
$soft_foo->(5);

my ($function, $class) = qw(foo Foo);
# "$class::$function"->(6); # no! `::' ambiguous in double-quoted string
"${class}::${function}"->(6); # canonical string interpolation

__END__

#### CAUTION: UNTESTED CODE ####

use strict;
use warnings;
use threads;
use threads::shared;

$|=1;
Worker->new(id=>1)->start;

while (1)
{
sleep 1;
}

# ********************************************************************
# BaseThreadedWorker class
# ********************************************************************
package BaseThreadedWorker;
use strict;
use warnings;
use threads;
use threads::shared;

sub new ($)
{
my ($class) = @_;

    my %hash : shared = (
        _status=>'STOPPED',
        );

return bless \%hash,$class;
}

sub start
{
my $this = shift;

    ###### return threads->new(\&onStart,$this);              ##### DELETE
    # use hard function ref ``passed back'' in blessed hash
    # that $this references.
    return threads->new($this->{_start_function_ref}, $this); ##### ADD
}

sub status
{
my ($this,$value) = @_;

    lock $this;
    return $this->{status} if (!defined($value));
    $this->{status} = $value;
}

# ********************************************************************
# Worker class
# ********************************************************************
package Worker;
use strict;
use warnings;
use base 'BaseThreadedWorker';

sub new
{
my ($class,%option) = @_;

my $this = $class->SUPER::new;
$this->{logger} = $option{logger} if ($option{logger});

    # add hard function ref in class where the method is defined
    # and ``pass it back'' in blessed hash.
    $this->{_start_function_ref} = \&onStart; ##### ADD

bless $this,$class;
return $this;
}

sub onStart
{
my $this = shift;

    $this->status('STARTING');
    eval
    {
        while (1)
        {
            foreach my $status (qw(EATING PLAYING HIDING SLEEPING WORKING))
            {
                {
                    lock $this;
                    $this->status($status);
                }
                sleep(2);
                if (!int(rand(5)))
                {
                    die "ARGH!";
                }
            }
        }
    };
    $this->status('STOPPED');
}

----------------------- end code ------------------------------

_______________________________________________
ActivePerl mailing list
[email protected]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs

Re: Qn on classes, inheritance, and threads

Reply via email to