Qn on classes, inheritance, and threads

In a message dated 3/28/2006 10:57:40 P.M. Eastern Standard Time, jhfoo-mlextracktor.com 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
"$::${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->; if (!defined($value));
    $this->; = $value;
}

 

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

 

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

 ;

    my $this = $class->;SUPER::new;
    $this->; = $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');
}

 

1;

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