Документация
HTML CSS PHP PERL другое

Section 1.2.  Messing with the Class Model

 
Previous
Table of Contents
Next

1.2. Messing with the Class Model

Perl's style of object orientation is often maligned, but its sheer simplicity allows the advanced Perl programmer to extend Perl's behavior in interestingand sometimes startlingways. Because all the details of Perl's OO model happen at runtime and in the openusing an ordinary package variable (@INC) to handle inheritance, for instance, or using the symbol tables for method dispatchwe can fiddle with almost every aspect of it.

In this section we'll see some techniques specific to playing with the class model, but we will also examine how to apply the techniques we already know to distort Perl's sense of OO.

1.2.1. UNIVERSAL

In almost all class-based OO languages, all objects derive from a common class, sometimes called Object. Perl doesn't quite have the same concept, but there is a single hard-wired class called UNIVERSAL, which acts as a last-resort class for method lookups. By default, UNIVERSAL provides three methods: isa, can, and VERSION.

We saw isa briefly in the last section; it consults a class or object's @ISA array and determines whether or not it derives from a given class:

    package Coffee;
    our @ISA = qw(Beverage::Hot);

    sub new { return bless { temp => 80 }, shift }

    package Tea;
    use base 'Beverage::Hot';

    package Latte;
    use base 'Coffee';

    package main;
    my $mug = Latte->new;

    Tea->isa("Beverage::Hot"); # 1
    Tea->isa("Coffee"); # 0

    if ($mug->isa("Beverage::Hot")) {
        warn 'Contents May Be Hot';
    }

Section 1.2.  Messing with the Class Model

isa is a handy method you can use in modules to check that you've been handed the right sort of object. However, since not everything in Perl is an object, you may find that just testing a scalar with isa is not enough to ensure that your code doesn't blow up: if you say $thing->isa(...) on an unblessed reference, Perl will die.

The preferred "safety first" approach is to write the test this way:

    my ($self, $thing) = @_;
    croak "You need to give me a Beverage::Hot instance"
     unless eval { $thing->isa("Beverage::Hot"); };

This will work even if $thing is undef or a non-reference.


Checking isa relationships is one way to ensure that an object will respond correctly to the methods that you want to call on it, but it is not necessarily the best one. Another idea, that of duck typing, states that you should determine whether or not to deal with an object based on the methods it claims to respond to, rather than its inheritance. If our Tea class did not derive from Beverage::Hot, but still had temperature, milk, and sugar accessors and brew and drink methods, we could treat it as if it were a Beverage::Hot. In short, if it walks like a duck and it quacks like a duck, we can treat it like a duck.[*]

[*] Of course, one of the problems with duck typing is that checking that something can respond to an action does not tell us how it will respond. We might expect a TRee object and a Dog to both have a bark method, but that wouldn't mean that we could use them in the same way.

The universal can method allows us to check Perl objects duck-style. It's particularly useful if you have a bunch of related classes that don't all respond to the same methods. For instance, looking back at our B::OP classes, binary operators, list operators, and pattern match operators have a last accessor to retrieve the youngest child, but nullary, unary, and logical operators don't. Instead of checking whether or not we have an instance of the appropriate classes, we can write generically applicable code by checking whether the object responds to the last method:

    $h{firstaddr} = sprintf("%#x", $ {$op->first}) if $op->can("first");
    $h{lastaddr}  = sprintf("%#x", $ {$op->last})  if $op->can("last");

Another advantage of can is that it returns the subroutine reference for the method once it has been looked up. We'll see later how to use this to implement our own method dispatch in the same way that Perl would.

Finally, VERSION returns the value of the class's $VERSION. This is used internally by Perl when you say:

    use Some::Module 1.2;

While I'm sure there's something clever you can do by providing your own VERSION method and having it do magic when Perl calls it, I can't think what it might be.

However, there is one trick you can play with UNIVERSAL: you can put your own methods in it. Suddenly, every object and every class name (and remember that in Perl a class name is just a string) responds to your new method.

One particularly creative use of this is the UNIVERSAL::require module. Perl's require keyword allows you to load up modules at runtime; however, one of its more annoying features is that it acts differently based on whether you give it a bare class name or a quoted string or scalar. That is:

    require Some::Module;

will happily look up Some/Module.pm in the @INC path. However, if you say:

    my $module = "Some::Module";
    require $module;

Perl will look for a file called Some::Module in the current directory and probably fail. This makes it awkward to require modules by name programatically. You have to end up doing something like:

    eval "require $module";

which has problems of its own. UNIVERSAL::require is a neat solution to thisit provides a require method, which does the loading for you. Now you can say:

    $module->require;

Perl will treat $module as a class name and call the class method, which will fall through to UNIVERSAL::require, which loads up the module.

Similarly, the UNIVERSAL::moniker module provides a human-friendly name for an object's class, by lowercasing the text after the final :::

    package UNIVERSAL;

    sub moniker {
        my ($self) = @_;
            my @parts = split /::/, (ref($self) || $self);
        return lc pop @parts;
    }

This allows you to say things like:

    for my $class (@classes) {
        print "Listing of all ".$class->plural_moniker.":\n";
        print $_->name."\n" for $class->retrieve_all;
        print "\n";
    }

Some people disagree with putting methods into UNIVERSAL, but the worst that can happen is that an object now unexpectedly responds to a method it would not have before. And if it would not respond to a method before, then any call to it would have been a fatal error. At worst, you've prevented the program from breaking immediately by making it do something strange. Balancing this against the kind of hacks you can perpetrate with it, I'd say that adding things to UNIVERSAL is a useful technique for the armory of any advanced Perl hacker.

1.2.2. Dynamic Method Resolution

If you're still convinced that Perl's OO system is not the sort of thing that you want, then the time has come to write your own. Damian Conway's Object Oriented Perl is full of ways to construct new forms of objects and object dispatch.

We've seen the fundamental techniques for doing this; it's now just a matter of combining them. For instance, we can combine AUTOLOAD and UNIVERSAL to respond to any method in any class at all. We could use this to turn all unknown methods into accessors and mutators:

    sub UNIVERSAL::AUTOLOAD {
        my $self = shift;
        $UNIVERSAL::AUTOLOAD =~ /.*::(.*)/;
        return if $1 eq "DESTROY";
        if (@_) {
           $self->{$1} = shift;
        }
        $self->{$1};
    }

Or we could use it to mess about with inheritance, like Class::Dynamic; or make methods part of an object's payload, like Class::Classless or Class::Object. We'll see later how to implement Java-style final attributes to prevent methods from being overriden by derived classes.

1.2.3. Case Study: Singleton Methods

On the infrequent occasions when I'm not programming in Perl, I program in an interesting language called Ruby. Ruby is the creation of Japanese programmer Yukihiro Matsumoto, based on Perl and several other dynamic languages. It has a great number of ideas that have influenced the design of Perl 6, and some of them have even been implemented in Perl 5, as we'll see here and later in the chapter.

One of these ideas is the singleton method, a method that only applies to one particular object and not to the entire class. In Perl, the concept would look something like this:

    my $a = Some::Class->new;
    my $b = Some::Class->new;

    $a->singleton_method( dump => sub {
      my $self = shift;
      require Data::Dumper; print STDERR Date::Dumper::Dumper($self)
    });

    $a->dump; # Prints a representation of the object.
    $b->dump; # Can't locate method "dump"

$a receives a new method, but $b does not. Now that we have an idea of what we want to achieve, half the battle is over. It's obvious that in order to make this work, we're going to put a singleton_method method into UNIVERSAL. And now somehow we've got to make $a have all the methods that it currently has, but also have an additional one.

If this makes you think of subclassing, you're on the right track. We need to subclass $a (and $a only) into a new class and put the singleton method into the new class. Let's take a look at some code to do this:

    package UNIVERSAL;

    sub singleton_method {
        my ($object, $method, $subref) = @_;

        my $parent_class = ref $object;
        my $new_class = "_Singletons::".(0+$object);
        *{$new_class."::".$method} = $subref;

        if ($new_class ne $parent_class) {
            @{$new_class."::ISA"} = ($parent_class);
            bless $object, $new_class;
        }
    }

First, we find what $a's original class is. This is easy, since ref tells us directly. Next we have to make up a new classa new package name for our singleton methods to live in. This has to be specific to the object, so we use the closest thing to a unique identifier for objects that Perl has: the numeric representation of its memory address.

0+$object

We don't talk a lot about memory locations in Perl, so using something like 0+$object to find a memory location may surprise you. However, it should be a familiar concept. If you've ever accidentally printed out an object when you expected a normal scalar, you should have seen something like Some::Class=HASH(0x801180). This is Perl's way of telling you that the object is a Some::Class object, it's based on a hash, and it lives at that particular location in memory.

However, just like the special variable $!, objects have a string/integer duality. If you treat an object as an ordinary string, you get the output we have just described. However, if you treat it as a number, you just get the 0x8801180. By saying 0+$object, we're forcing the object to return its memory location, and since no two objects can be at the same location, we have a piece of data unique to the object.


We inject the method into the new class with glob assignment, and now we need to set up its inheritance relationship on $a's own class. Since Perl's inheritance is handled by package variables, these are open for us to fiddle with dynamically. Finally, we change $a's class by re-blessing it into the new class.

The final twist is that if this is the second time the object has had a singleton method added to it, then its class will already be in the form _Singleton::8393088. In this case, the new class name would be the same as the old, and we really don't want to alter @ISA, since that would set up a recursive relationship. Perl doesn't like that.

In only 11 lines of code we've extended the way Perl's OO system works with a new concept borrowed from another language. Perl's model may not be terribly advanced, but it's astonishingly flexible.

    Previous
    Table of Contents
    Next
    © 2000- NIV