Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Could someone help me in understanding a piece of codes 1

Status
Not open for further replies.

whn

Programmer
Oct 14, 2007
265
US
At first, let me show you the source codes.
1) Base class
Code:
package Core::Accessor;

sub new {
  my $class = shift;
  my $self = bless {}, ref $class || $class;
  
  if ( $self->[b]can[/b]( 'init' ) ) {
    [COLOR=blue]# can not find the implementation of subtorutine 'can()'[/color]
    if ( ! $self->init( @_ ) ) {
      undef( $self );
    }
  }
  return $self;
}

[b][COLOR=red]sub register_fields {[/color][/b]
  my ( $self, @fields ) = @_;

  foreach my $field ( @fields ) {
    if ( ! $self->[b]can[/b]( $field ) ) {
      $self->make_accessor( $field );
    }
    $self->$field( undef );
  }
}

sub make_accessor {
  my ( $self, $field ) = @_;
  my $class = ref( $self );

  no strict 'refs';

[COLOR=blue][b]  # Question: Could someone please explain what '*{ "${class}::${field}" }' is, 
  # especially, the leading '*'?[/b][/color]
  [COLOR=red][b]*{ "${class}::${field}" }[/b] =  sub { 
    my ( $self, $value ) = @_;
    @_ > 2 and die 'Wrong usage!';
    my $attr = $self->attr_name( $field );
    my $type = ref( $self->{ $attr } );
    if ( @_ == 1 ) {
      return $self->{ $attr };
    }
    else {
      return $self->{ $attr } = $value;
    }
  };[/color]
}

sub attr_name {
  my ( $self, $field ) = @_;
  return $self->PREFIX() . $field;
}

sub PREFIX { '_' };

1;

First question: Odd enough, I can not find the implementation of subroutine ‘can()’ anywhere. The command I used to find it:

Code:
% find . –name \* | xargs grep ‘sub can’

The ‘.’ in the cmd above is the top level of the whole test suite.

Below is a child class:
Code:
package Switch;

use strict;
use base qw(Core::Accessor);

# This child class has its own constructor
sub new {
  my $proto = shift;
  my $hash = shift; # startup hash
  my $class = ref($proto) || $proto;
  my $self  = {};
  bless ($self, $class);
  $self->init($hash);
  return $self;
}

sub init {
  my $self = shift;
  my $hash = shift;
  # some implementations here
  [COLOR=red]$self->[b]register_fields('abc')[/b][/color];
  # some implementations here
}

sub check_abc {
  my $self = shift;
  my $deadpaths  = shift;
  # some implementations here
  [b][COLOR=red]$self->abc($var);[/color][/b]
  # some implementations here
}

1;

Yet, another child class:
Code:
package Sys::Stat::IO;

use base qw( Core::Accessor );

# This child class will use the constructor in base class
sub init {
  my $self = shift;
  # some implementations here
  [b][COLOR=red]$self->register_fields('xyz');[/color][/b]
  # some implementations here
}

sub get_xyz {
  my $self = shift;
  # some implementations here
  [b][COLOR=red]return $self->xyz();[/color][/b]
}

1;

Second question: I know the implementions for both Sys::Stat::IO..xyz() and Switch..abc() are in the red part in Core::Accessor..make_accessor(). But I can not understand how xyz() is different from abc()? Or should abc() be different from xyz()? If they are different, then what the difference is?

Also, another question is embedded in the source code of the base class.


I am new to OOP in perl and I hope I have made myself clear. Thank you so much for your help.
 
The *{} format is how this code is declaring dynamic subroutines at run-time. Perl keeps a symbol table of all the variables and things in memory (you can have $var and @var for example, one being a scalar and the other an array, but both with different data... the $ denotes a scalar and the @ an array... the * denotes everything, like a wildcard, and it's the only way in Perl you could create a named subroutine at run-time).

The can() function iirc is a built-in, it tests whether an object has a function or not; it's similar to, in JavaScript, how you can test "if (document.getElementById)" to see if the browser supports getElementById before you actually attempt to call it (which would result in an error if the browser doesn't support it).

Kirsle.net | My personal homepage
Code:
perl -e '$|=$i=1;print" oo\n<|>\n_|_";x:sleep$|;print"\b",$i++%2?"/":"_";goto x;'
 
Thank you, Kirsle, for your help (and the link!!).

But I still have a question. In the example in my original post, is there any difference between subroutine xyz() and subroutine abc(). To me, the only difference is the subroutine name and they should perform the exact same tasks.

Could you or someone else explain it to me?

Many thanks.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top