הלינקייה: מגזין חודשי למפתחים

רוצה לשמוע על כל האירועים, המדריכים, הקורסים והמאמרים שנכתבו החודש ?
הלינקייה הינו מגזין חופשי בעברית שמשאיר אותך בעניינים.
בלי ספאם. בלי שטויות. פעם בחודש אצלך בתיבה.

Object Oriented

Perl OO Using Moose

Moose is now the standard perl's OO library. It is available via cpan, and provides us with a much simpler, cleaner and effective OO style. We'll start by learning how modern perl coders write OO code using Moose, and then we'll examine some of the legacy code written in old OO perl.

  

Perl Object Oriented Programming on Prezi

The Moose Meta Object

In addition to being good syntactic sugar and saving us tons of typing, Moose also provides us with a meta object protocol for "reflection" like behavior.
Here's a simple example on how to use that.

use Modern::Perl;
use Carp;
 
package MySuper;
use Moose;
 
sub hello {
    say 'hello';
}
 
sub is_hello_overriden {
    my $self = shift;
    my $meta = $self->meta;
    if ( $meta->has_method('hello') ) { 
        warn 'object has the method hello';
    }   
}
 
package Deriv1;
use Moose;
extends 'MySuper';
 
sub hello {
    say 'foo';
}
 
package Deriv2;
use Moose;
extends 'MySuper';
package main;
my $d1 = Deriv1->new;
my $d2 = Deriv2->new;
my $s  = MySuper->new;
 
$s->is_hello_overriden;
$d1->is_hello_overriden;
$d2->is_hello_overriden;
 

Perl Standard OOP system is extremely thin, so users can pretty much do anything they want with it. This has the downside of usually having to write more code than needed. The first few examples demonstrate the usage of that basic object system.

On the second part, we'll explore the Moose library, which is today the standard OOP library for perl. Moose is built on top of the basic

package SimpleCritter;
 
sub new {
        my $class = shift;
        my $self = { age => 0 };
 
        bless $self, $class;
        return $self;
}
 
sub make_sound {
        print "Miao\n";
}
 
1;
 
use Modern::Perl;
use SimpleCritter;
 
my $crit = new SimpleCritter;
 
$crit->make_sound;
package Person;
use strict;
use warnings;
use Carp;
 
sub new {
    my ($class, $params) = @_;
warn 'Creating new object of class: ', $class;
 
    my $self = {};
 
    bless $self, $class;
 
    $self->_init($params);
 
    return $self;
}
 
sub _init {
    my ($self, $params) = @_;
    $self->{age} = $params->{age} || 7;
    $self->{city}= $params->{city} || 'Haifa';
    $self->{name} = $params->{name} || 'Frida';
}
 
sub set_name {
    my ($self, $val) = @_;
    $self->{name} = $val;
}
 
sub get_name {
    my ($self) = @_;
    return $self->{name};
}
 
sub hello {
    my ($self) = @_;
    print '[ ', $self->{age}, ' ] Hello, my name is ', 
            $self->{name}, 
          ' And I live in ', $self->{city}, "\n";
}
 
1;
package Student;
use strict;
use warnings;
use Carp;
 
#our @ISA = qw(Person);
use base 'Person';
 
sub _init {
    my ($self, $params) = @_;
 
    $self->SUPER::_init($params);
 
    $self->{grades} = $params->{grades} || 74;
}
 
sub grades {
    my ($self) = @_;
    return $self->{grades};
}
 
1;
 
use strict;
use warnings;
use Carp;
 
use Person;
use Student;
 
my $p = Person->new;
 
my $q = Person->new({age => 15 });
 
$p->hello;
 
Person::hello($p);
 
warn 'time passes ...';
 
$p->set_name('Lihi');
$p->hello;
$q->hello;
 
my $s = new Student({age => 24});
 
$s->hello;
warn 'my grades are: ', $s->grades;
 
 
sub create {
        my $class = shift;
        my $self = {age => 0, @_};
 
        bless $self, $class;
        return $self;
}
 
sub hello {
        my $self = shift;
 
        print "Hello, I am a critter and my age is: ",
                $self->{age}, "\n";
}
 
sub age {
        my ($self, $age) = @_;
        $self->{age} = $age if defined($age);
 
        return $self->{age};
}
 
1;
use strict;
use warnings;
use Critter;

my $crit = create Critter(1,2,3);
 
$crit->hello;
print "Crit is: ", ref $crit, "\n";
$crit->age(10);
$crit->hello;
 
print "crits age is: ", $crit->age, "\n";

package Stack;
 
sub push {
  my $self = shift;
  my $data = $self->{data};
  push @$data, @_;
}
 
sub pop {
  my $self = shift;
  my $data = $self->{data};
 
  my $item = pop @$data;
  return $item;
}
 
sub new {
  my $class = shift;
  my $self = { };
  bless $self, $class;
  $self->_init;
  return $self;
}
 
sub _init {
  my $self = shift;
  $self->{data} = [];
}
 
package SizedStack;
require Stack;
@ISA = (Stack);
 
sub _init {
  my $self = shift;
  $self->SUPER::_init;
  $self->{size} = 0;
}
 
sub push {
  my $self = shift;
  $self->SUPER::push(@_);
  $self->{size}+= scalar(@_);
}
 
sub pop {
  my $self = shift;
  my $item = $self->SUPER::pop;
  $self->{size}-= scalar(@_);
  return $item;
}
 
sub size {
  my $self = shift;
  return $self->{size};
}
 
1;
use Stack;
 
my $stack = new Stack;
 
my $sized = new SizedStack;
 
$stack->push(10, 20, 30);
$sized->push(1, 2, 3, 4);
 
print "size = ", $sized->size, "\n";
my $next;
 
print "$next,", while $next=$sized->pop;
print "\n";
 
 
print "$next,", while $next=$stack->pop;
print "\n";
 
course: