skazat has asked for the wisdom of the Perl Monks concerning the following question:

i'm trying to make an almost tranparent package i guess you could call it...

i want to make a class that can change depending on what info i give it. (this is right from perlobj) 

 

package PRODUCT;
use Carp; 

use strict;
use vars qw($AUTOLOAD);
  


my %fields = (
name => undef, 
price => undef, 
description => undef,
); 


sub new { 
my $product = shift; 
my $class = ref($product) || $product; 

   my $self = { 
   _permitted => \%fields, 
   %fields, 
   };
   bless $self, $class; 
   return $self; 


}

sub AUTOLOAD { 

my $self = shift; 
my $type = ref($self) 
            or croak "$self is not an object"; 
          
my $name = $AUTOLOAD; 
   $name =~ s/.*://; #strip fully-qualified portions

unless (exists $self ->{_permitted} ->{$name} ) { 
croak "Can't access `$name' field in class $type"; 
} 


if (@_) { 
   return $self -> {$name} = shift; 
   }else{
      return $self-> {$name}; 
      
    }  

}

[download]

do you see how the data fields are shown right up top there? why (or how..) can i do that for other functions in the package? So instead of hardcoding:

 

### Pack s the current field into a comma delimited record 
### and returns it 

sub pack {   
   my ( $self ) = @_; 
   
   my $record = join(':', $self->{name} , $self->{price}, $self->{desc
+ription}); 
   
   return $record; 
   
}

[download]

i could just dynamically do that using the data in %fields? that way, i could make a wholly universal package for multiple classes and i don't have to retype functions (and change them just that much) and the code would be super exportable

Can anyone help me on this?

thanks!

justin

Replies are listed 'Best First'.
Re: Stumped on an OO Problem
by chromatic (Archbishop) on Jun 27, 2000 at 22:29 UTC
    You could make a generic method, something like this: 
    sub pack {
    my $self = shift;
    my $order = $self->{_order};
    
    my $record = join(':', @$self{@$order});
    return $record';
}

    [download]
    You'd have to add _order to the member data of your object. Here, it's an anonymous list of the fields you want to be exported, in the correct order. We use a hash slice to get the fields for the join statement. (This is untested code, but you are looking for design hints so it's okay.)

    It's not beautiful, because it tends to break encapsulation. Perhaps you could add a method that returns the correct order, and the exportable keys. That's cleaner: 

    sub pack {
    my $self = shift;
    my @order = $self->order();
    
    my $result = join(':', @$self{@order});
    return $result;
}

    [download]
    In your individual objects, you don't even have to make _order a member of the blessed hash. Use closurely-goodness to prevent anyone from messing with it, if you're so inclined: 
    {
    my @order = qw( name price description );
    sub order {
        return @order;
    }
}

    [download]
    As a side note, you probably want to write your own DESTROY method, or at least escape it in your AUTOLOAD method. That can come back to haunt you later, if you extend this class: 
    sub DESTROY {
    # even if it's empty, it won't hit AUTOLOAD
}

    [download]
[reply]
[d/l]
[select]
Re: Stumped on an OO Problem
by ZZamboni (Curate) on Jun 27, 2000 at 22:41 UTC
    I'm not sure if I'm fully understanding what you want, but you could do something like this for your pack function: 
      sub pack {
        my $self=shift;
        my $record=join(':', @{$self}{keys %{$self->{_permitted}}});
        return $record;
  }

    [download]
    The keys of the _permitted element in your object are being used to index into the $self hash to extract the values. The problem with this is that you don't know what order the keys are going to come out. To solve that, I would suggest doing the initialization thusly: 
    my @permitted=qw(name price description);
my %fields;
@fields{@permitted}=undef;

    [download]
    And then assign %fields to _permitted as before. But now you have also the @permitted array, which would allow you to write pack as follows, giving you control over the order in which the elements are packed: 
      sub pack {
        my $self=shift;
        my $record=join(':', @{$self}{@permitted});
        return $record;
  }

    [download]

    --ZZamboni

[reply]
[d/l]
[select]
      ZZamboni wrote: 
          > But now you have also the @permitted
    > array, which would allow you to write pack as follows,
    > giving you control over the order in
    > which the elements are packed: 
    > 
    > 
    > sub pack {
    >     my $self=shift;
    >     my $record=join(':', @{$self}{@permitted});
    >     return $record;
    > }

      [download]
      No... this breaks inheritance, because you're trying to use @permitted in a different scope than where it was defined. @permitted is scoped lexically to the file in which it was defined, so you can't try to use it in your generic parent class, which is, presumably, where pack would be defined.

      A solution would be to take a reference to the array and store it in your object, as we're already doing with %fields.

[reply]
[d/l]
        Good point, since skazat's intent was to build a general container class, where subclasses would only define the desired fields. So how about this (which should also satisfy chromatic :-). No file or global variables. Only define the "fields" subroutine which returns the permitted fields in the desired order. The constructor uses that to build the _permitted element, and the rest of the code is pretty much the same. Defining a new subclass only needs the definition of fields, as shown by SUBPRODUCT below. The fields are not inherited, although that could probably be fixed by traversing the hierarchy calling fields() at each level. 
        package PRODUCT;
  use Carp; 

  use strict;
  use vars qw($AUTOLOAD);
    
    sub fields {
        return qw(data);
    }

  sub new { 
  my $product = shift; 
  my $class = ref($product) || $product; 
  my $self={};
  bless $self, $class;
  my %fields;
  @fields{$self->fields}=undef;
  $self->{_permitted} = \%fields;
  $self->{$_}=$fields{$_} for (keys %fields);
  return $self;
  }

  sub AUTOLOAD { 

  my $self = shift; 
  my $type = ref($self) 
              or croak "$self is not an object"; 
            
  my $name = $AUTOLOAD; 
     $name =~ s/.*://; #strip fully-qualified portions

  unless (exists $self ->{_permitted} ->{$name} ) { 
  croak "Can't access `$name' field in class $type"; 
  } 


  if (@_) { 
     return $self -> {$name} = shift; 
     }else{
        return $self-> {$name}; 
        
      }  

  }

  sub DESTROY {}

  sub pack {
        my $self=shift;
        my $record=join(':', @{$self}{$self->fields});
        return $record;
  }

package SUBPRODUCT;

use vars qw(@ISA);

@ISA=qw(PRODUCT);

sub fields {
        return qw(name price description);
}

1;

        [download]

        --ZZamboni

[reply]
[d/l]
Re: Stumped on an OO Problem
by btrott (Parson) on Jun 27, 2000 at 22:31 UTC
    I think you could just do something like this: 
        sub pack {
        my $self = shift;
        return join ':',
               map $self->{$_},
               keys %{ $self->{_permitted} };
    }

    [download]
    $self->{_permitted} is a reference to %fields. So we take the keys in %fields (the names of your data members), and for each of those we get the values of those fields held by your object; then we join those values into a colon-separated string. Is that what you wanted?
[reply]
[d/l]
Re: Stumped on an OO Problem
by skazat (Chaplain) on Jun 28, 2000 at 01:38 UTC
    yikes, this is a bit over my head, i might go with laziness now and worry about being reusable later... thanks for all your help, ZZAmboni's code seems to work with a bit of tweeking: 
     

    
#!/usr/bin/perl -w 

package PRODUCT;
use Carp; 
use strict;
use vars qw($AUTOLOAD);
   
sub fields {
   return qw(data);
}

sub new { 

 my $product = shift; 
 my $class = ref($product) || $product; 
 my $self={};
 bless $self, $class;
 my %fields;
 @fields{$self->fields}=undef;
 $self->{_permitted} = \%fields;
 
 for(keys %fields){
 $self->{$_}=$fields{$_} 
 
 }
 return $self;

}



 sub AUTOLOAD { 

 my $self = shift; 
 my $type = ref($self)
 or croak "$self is not an object"; 
   
 my $name = $AUTOLOAD; 
 $name =~ s/.*://; #strip fully-qualified portions

 unless (exists $self ->{_permitted} ->{$name} ) { 
     croak "Can't access `$name' field in class $type"; 
 
 } 


if (@_) { 
    return $self->{$name} = shift; 
}else{
    return $self->{$name};    
 }  

 }


sub DESTROY {}

sub pack {
   my $self=shift;
   my $record=join(':', @{$self}{$self->fields});
   return $record;
 }

  







 package SUBPRODUCT;
   use vars qw(@ISA);
   @ISA=qw(PRODUCT);




sub fields {
   return qw(name price description);
}

   1;


</pre>

    [download]
    
 

    (just small syntax stuff) 
     

    
-justin simoni
    
!skazat!
[reply]
[d/l]

Back to Seekers of Perl Wisdom