Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer

Not quite an OO tutorial

by GrandFather (Sage)
on Feb 23, 2011 at 10:21 UTC ( #889771=perlmeditation: print w/ replies, xml ) Need Help??

I put the following code sample on my scratch pad to encourage Lady_Aleena to investigate object oriented Perl. To my surprise it seems to be working (LA took notice ;) ). To my further surprise others have noticed and seem to like it so I captured the code here to give it a little more permanence and to provide a better forum for discussion than the CB.

I've split the code into a module and a script (although the original sample had all the code in the script) as a sop toward the convention of placing library code in modules. First the module code (placed in a file named

use strict; use warnings; package RandThing; use overload '""' => '_asStr'; sub new { my ($class, @values) = @_; my $self = bless {values => \@values}, $class; $self->genValue (); return $self; } sub _asStr { my ($self) = @_; return $self->{value}; } sub genValue { my ($self) = @_; $self->{value} = $self->{values}[rand @{$self->{values}}]; return $self->{value}; } package RandDayPart; use parent -norequire, 'RandThing'; sub new { my ($class) = @_; my @values = qw(morning evening afternoon night); return $class->SUPER::new (@values); } package RandLight; use parent -norequire, 'RandThing'; sub new { my ($class) = @_; my @values = qw(bright dark gloomy dazzling); return $class->SUPER::new (@values); } package RandWeather; use parent -norequire, 'RandThing'; sub new { my ($class) = @_; my @values = qw(stormy windy rainy calm); return $class->SUPER::new (@values); } 1;

and the sample script:

use strict; use warnings; use RandomThings; my $dp = RandDayPart->new (); my $lt = RandLight->new (); my $wt = RandWeather->new (); my $tense = RandThing->new ('was', 'is', 'will be'); print "It $tense a $lt and $wt $dp.\n"; $dp->genValue (); print "It $tense a $lt and $wt $dp.\n";

which when run prints stuff like:

It was a bright and rainy morning. It was a bright and rainy evening.

First off, try to ignore the overload stuff (use overload and _asStr) which is really there as a cute way to avoid a bunch of method calls and concatenation operators when composing strings (and if that doesn't make sense yet just let your eyes glaze over and ignore it).

Ok, so look at the code between package RandThing and package RandDayPart. That is the code for the RandThing base class. sub new is the 'constructor'. It is used to create a RandThing (or derived class) 'object'. You can see how it is used in the my $tense = RandThing->new ('was', 'is', 'will be'); line in the sample script. The magic is in the bless which takes a reference (in this case a hash reference) and ties it to a variable using some magic string.

The magic kicks in when you 'call a member function' using code like $self->genValue ();. The blessed magic finds the genValue sub in the RandThing package and calls it passing $self as the first parameter. Notice that genValue creates a local variable $self and set it to the first parameter passed to the sub. We can now use $self in the sub to access the data referenced in the bless that created the object (look a sub genValue to see what I mean).

Ok, so far so good, but a lot of work for no apparent gain eh (still ignoring the overload stuff remember)?

In this example the good stuff becomes evident when we need to add a few different types of random thing. Really what we want is to have a few RandThingXXX types which provide their own lists of values. There are of course many ways to achieve that of course and, as with most fairly trivial examples, this probably isn't the best way. However ...

Take a look at the code following package RandDayPart. Note that there are a number of rather similar looking blocks, each prefixed by a package line. Note too that each block has a use parent line and a new sub, but nothing else.

The use parent makes the current package a 'sub-class' of the parent ('base') class. That means that if the bless magic can't find a 'member function' in the current package it will look in the parent package (and so on up if required). This stuff is 'inheritance' and is what lets us write all those packages that just have a constructor in them, but which still do useful stuff. Most of the real work gets done in the base class.

Note that the derived class constructors (new subs in RandDayPart etc.) use SUPER to call new in the parent package. The actual object is created in RandThing using values passed in by the derived class constructors.

Now, that's probably not anywhere near enough explaination yet, but I'm going to let the dust settle a little at this point and see who has questions or comments.

True laziness is hard work

Comment on Not quite an OO tutorial
Select or Download Code
Re: Not quite an OO tutorial
by lostjimmy (Chaplain) on Feb 23, 2011 at 16:00 UTC
    I think this is a great tutorial on how OO and inheritance work within perl; however, I don't think this is a great example of inheritance. This would be akin to making a vector class, then having specialized vectors that simply initialize the list with a different set of items.

    A more sane approach would be to simply use the base class and pass it the list directly. The module could also provide pre-created instances or creator methods for convenience. In fact, you already show that with the $tense object.

      Indeed! Inheritance is an occasional thing and finding good succinct examples is hard. However the example isn't quite as bad as a first glance may suggest. The virtue in providing derived classes here is that you don't have to repeat the same list of values if you want to use the same object type in multiple places. There are however many other ways much the same result could be could be achieved that don't require OO let alone inheritance.

      True laziness is hard work
Re: Not quite an OO tutorial
by gnosti (Friar) on Feb 24, 2011 at 05:50 UTC
    I am pleased with the combined examples of overload, 'use parent' (as opposed to 'our @ISA =....') and a simple yet interesting application.

    I think this is a great, minimalist way to understand OO, compared with a big black-boxish and black-magical Moose.

    A functional example of solving the same problem, suggested by lostjimmy, would be valuable for demonstrating a different approach.

    Good work GF. btw, I'm impressed by your C.V. Hope any friends/family in Christchurch are okay.

      Since GrandFather wrote the object oriented code above for me, I am more than willing to show how I would write it in functions. I let my eyes glaze over on the overdrive bit, so I don't have a functional way to do that (if there is a way, that is).

      Let's start with the module:

      packack Random::Things; use strict; use warnings; use base 'Exporter'; our @EXPORT_OK = qw(RandDayPart RandLight RandWeather RandTense); sub RandDayPart { my @randdaypart = qw(morning evening afternoon night); return $randdaypart[rand @randdaypart]; } sub RandLight { my @randlight = qw(bright dark gloomy dazzling); return $randlight[rand @randlight]; } sub RandWeather { my @randweather = qw(stormy windy rainy calm); return $randweather[rand @randweather]; } sub RandTense { my @randtense = ('was', 'is', 'will be'); return $randtense[rand @randtense]; } 1;

      Now the script:

      use strict; use warnings; use Random::Things qw(RandDayPart RandLight RandWeather RandTense); my $random_day_part = RandDayPart; my $random_light = RandLight; my $random_weather = RandWeather; my $random_tense = RandTense; print "It $random_tense a $random_light and $random_weather $random_da +y_part."

      It may not be nice and have things like inheritance that the OO version has, but it will do the same thing in a crunch.

      Have a cookie and a very nice day!
      Lady Aleena
        I would skip the duplication and the exporting of functions, something like this:

        package Rand; use strict; use warnings; sub _random { my @values = @_; return $values[rand @values]; } sub day_part { return _random(qw(morning evening afternoon night)); } sub light { return _random(qw(bright dark gloomy dazzling)); } sub weather { return _random(qw(stormy windy rainy calm)); } sub tense { return _random('was', 'is', 'will be'); } 1;

        and the example code would look like this:
        use strict; use warnings; use Rand; my $random_day_part = Rand::day_part; my $random_light = Rand::light; my $random_weather = Rand::weather; my $random_tense = Rand::tense; print "It $random_tense a $random_light and $random_weather $random_da +y_part."
      I think this is a great, minimalist way to understand OO, compared with a big black-boxish and black-magical Moose.

      I will agree that Moose is very black-boxish, but it is actually very much not black-magical. From the very start Moose has tried to avoid all deep black magic hacks that have plagued so many previous attempts at improving Perl OO.

      In short, black magic is inherently fragile and ill advised, we (Moose core devs) avoid it.

      Of course, I am speaking of Moose, not MooseX::Declare which has TONS of black magic in it.

Re: Not quite an OO tutorial
by Lady_Aleena (Deacon) on Feb 27, 2011 at 08:26 UTC

    Thank you for taking the time to type this all out for everyone and me. Have a cookie! Now, I have some questions, though they aren't about OO specifically.

    1. How would you control explosive growth with this? I could sneeze and come up with a new list of items that I would like to randomize. Do I just keep adding new things to the top under RandThing and maybe keeping a list in a comment? The current set up looks a bit bulky for all of the randomizing I would be doing with this. Below are two lists I came up with while sitting here, and I may actually use them some day.
      package RandWritingImplement; use parent -norequire, 'RandThing'; sub new { my ($class) = @_; my @values = qw(pencil pen marker crayon chalk); return $class->SUPER::new (@values); } package RandWritingSurface; use parent -norequire, 'RandThing'; sub new { my ($class) = @_; my @values = qw(paper parchment slate hide stone); return $class->SUPER::new (@values); }
    2. How would RandThing be modified to accept not only arrays but also hashes? There are times where the list comes from a single hash key, the list could be the hash keys, or all of the arrays in the hash jumbled into one large list. Below is a subroutine I wrote which does it all for me, except that it doesn't take direct input.
      sub _random { my ($list,$key) = @_; my @random_array; if (ref($list) eq "HASH") { if ($list->{$key}) { @random_array = @{$list->{$key}}; } elsif ($key eq 'keys') { @random_array = (keys %{$list}); } elsif ($key eq 'all') { @random_array = map(@{$list->{$_}},keys %{$list}); } else { die q(You need to select a key from the hash, "all" keys, or jus +t "keys".); } } elsif (ref($list) eq "ARRAY") { @random_array = @{$list}; } else { die q(What are you doing? You didn't enter a hash or an array.); } return $random_array[rand @random_array]; }

    These are two issues that I don't see an answer for in the current set up. OO does sound appealing, however, it appears to be very bulky for even something as simple as randomizing a lot of lists.

    Have a cookie and a very nice day!
    Lady Aleena

      First off remember that the sample code in the OP was intended as demo code that touches a little on a real problem, but isn't intended as a serious solution to the original problem. In particular it doesn't scale well - that is, it really is a bad solution if you want to add many, many different groups of random things.

      A better solution if you want to add many different types of random things is to write a class that addresses that issue. There are many ways you could do that. Given that the list is likely to grow over time and that groups of things may be added at run time having a few different ways of adding groups is probably needed. I'd start with something like this:

      use strict; use warnings; package RandThing; use overload '""' => 'getValue'; my %_groups; # Load default groups while (<DATA>) { chomp; next if ! length; my ($type, @values) = split /,/; $_groups{$type} = \@values; } return 1; sub new { my ($class, $type, @values) = @_; die "RandThing::new must be called using RandThing->new ('type') s +yntax!\n" if ! defined $class || ref $class; die "$class->new requires a group type parameter\n" if ! defined $type; die "Group type $type is unknown and no values given to define a n +ew type\n" if ! exists $_groups{$type} && ! @values; if (! @values) { # Use an existing group @values = @{$_groups{$type}}; } elsif (ref $values[0]) { $_groups{$type} = \(@values = doLAMagic (@values)); } else { # Add a new group or update an old one $_groups{$type} = \@values; } my $self = bless {values => \@values}, $class; $self->genValue (); return $self; } sub doLAMagic { my ($list, $key) = @_; my @values; return @$list if 'ARRAY' eq ref $list; return @{$list->{$key}} if exists $list->{$key}; return keys %{$list} if $key eq 'keys'; return map (@{$list->{$_}}, keys %{$list}) if $key eq 'all'; $key = 'undef value' if ! defined $key; die "Can't do LA magic on a hash using $key. 'keys' or 'all' requi +red"; } sub getValue { my ($self) = @_; return $self->{value}; } sub genValue { my ($self) = @_; $self->{value} = $self->{values}[rand @{$self->{values}}]; return $self->{value}; } __DATA__ Weather,stormy,windy,rainy,calm Light,bright,dark,gloomy,dazzling DayPart,morning,evening,afternoon,night

      which can be used in similar fashion to the previous sample:

      use strict; use warnings; use RandThing; my $dp = RandThing->new ('DayPart'); my $lt = RandThing->new ('Light'); my $wt = RandThing->new ('Weather'); my $tense = RandThing->new ('Tense', 'was', 'is', 'will be'); my $la = RandThing->new ('LA', [qw(Lady Aleena magic)]); print "It $tense a $lt and $wt $dp ($la).\n";

      Now you still have the overload magic, a bunch of default group types, the ability to add new group types and a simple way of extending the list of default group types. Oh, and for good measure I tossed in some Lady Aleena magic ;).

      True laziness is hard work

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://889771]
Approved by Corion
Front-paged by planetscape
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (4)
As of 2015-05-07 03:42 GMT
Find Nodes?
    Voting Booth?

    In my home, the TV remote control is ...

    Results (154 votes), past polls