Modern Perl

Daniel Bruder, M.A.

CIS, LMU, 06/2014

Modern Perl

Moderne Software-Enwicklung in Perl

Language Features

Toolchain

perlbrew

Toolchain

cpanm

Toolchain

Dist::Zilla

Toolchain

Moose...

Moose Goodies: Methoden

Moose hat darüber hinaus:

Moose Goodies: Roles

Moose Goodies: Types

Moose Goodies: MOP

Moose Goodies: eXtensions

Attributes

Das Herzstück von Moose

Attributes

Attributes

package main;

my $p1 = Person->new;
my $p2 = Person->new(name => 'Foo');

$p1->name('Bar');
say $p1->name, " ", $p2->name;

Sweet Classes

package Person;
 
use DateTime;
use DateTime::Format::Natural;
use Moose;
use Moose::Util::TypeConstraints;
 
has name => (
    is       => 'rw',
    isa      => 'Str',
    required => 1,
);

# ...

Sweet Attributes

# ...

has birth_date => (
    is      => 'rw',
    isa     => 'DateTime',
);

# ...

Sweet Attributes

# Moose doesn't know about non-Moose-based classes.
class_type 'DateTime';
 
my $en_parser = DateTime::Format::Natural->new(
    lang      => 'en',
    time_zone => 'UTC',
);
 
coerce 'DateTime'
    => from 'Str'
    => via { $en_parser->parse_datetime($_) };

# ...

Sweet Attributes

# Moose doesn't know about non-Moose-based classes: coerce it!
has birth_date => (
    is      => 'rw',
    isa     => 'DateTime',
    coerce  => 1,
);
# ...

Sweet Attributes: Delegation and API Design

# Delegate to DateTime->year() and expose birth_year in API!
has birth_date => (
    is      => 'rw',
    isa     => 'DateTime',
    coerce  => 1,
    handles => { birth_year => 'year' },
);
# ...

More Sweet Attributes and Types

enum 'ShirtSize' => qw( s m l xl xxl );

has shirt_size => (
   is      => 'rw',
   isa     => 'ShirtSize',
   default => 'l',
);

Sweet Inheritance

package User;
 
use Email::Valid;
use Moose;
use Moose::Util::TypeConstraints;
 
extends 'Person';
 
has email_address => (
    is       => 'rw',
    isa      => 'Email',
    required => 1,
);

Sweet Attributes and Types (more)

subtype 'Email'
    => as 'Str'
    => where { Email::Valid->address($_) }
    => message { "$_ is not a valid email address" };

Voilà

use Person;

my $person = Person->new(
  name => 'Bob',
  birth_date => 'Dec 24 1789'
);

say $person->name,
  ' was born in the year of ', $person->birth_year,
  ' and wears shirt size: ', $person->shirt_size;

Voilà

use User;

my $user = User->new(
  name => 'Anne',
  email_address => 'jane@example.com',
  shirt_size => 's'
);

say $user->name, "'s email address is: ", $user->email_address;
say $user->name, "'s shirt size is: ", $user->shirt_size;

Voilà

Bitter P5-plain (Reference)

package Person;
 
use strict;
use warnings;
 
use Carp qw( confess );
use DateTime;
use DateTime::Format::Natural;
 
sub new {
    my $class = shift;
    my %p = ref $_[0] ? %{ $_[0] } : @_;
 
    exists $p{name}
        or confess 'name is a required attribute';
    $class->_validate_name( $p{name} );
 
    exists $p{birth_date}
        or confess 'birth_date is a required attribute';
 
    $p{birth_date} = $class->_coerce_birth_date( $p{birth_date} );
    $class->_validate_birth_date( $p{birth_date} );
 
    $p{shirt_size} = 'l'
        unless exists $p{shirt_size}:
 
    $class->_validate_shirt_size( $p{shirt_size} );
 
    return bless \%p, $class;
}

Bitter P5-plain (continued)

sub _validate_name {
    shift;
    my $name = shift;
 
    local $Carp::CarpLevel = $Carp::CarpLevel + 1;
 
    defined $name
        or confess 'name must be a string';
}
 
{
    my $en_parser = DateTime::Format::Natural->new(
        lang      => 'en',
        time_zone => 'UTC',
    );
 
    sub _coerce_birth_date {
        shift;
        my $date = shift;
 
        return $date unless defined $date && ! ref $date;
 
        my $dt = $en_parser->parse_datetime($date);
 
        return $dt ? $dt : undef;
    }
}

Bitter P5-plain (continued)

sub _validate_birth_date {
    shift;
    my $birth_date = shift;
 
    local $Carp::CarpLevel = $Carp::CarpLevel + 1;
 
    $birth_date->isa('DateTime')
        or confess 'birth_date must be a DateTime object';
}
 
sub _validate_shirt_size {
    shift;
    my $shirt_size = shift;
 
    local $Carp::CarpLevel = $Carp::CarpLevel + 1;
 
    defined $shirt_size
        or confess 'shirt_size cannot be undef';
 
    my %sizes = map { $_ => 1 } qw( s m l xl xxl );
 
    $sizes{$shirt_size}
        or confess "$shirt_size is not a valid shirt size (s, m, l, xl, xxl)";
}

Bitter P5-plain (continued)

sub name {
    my $self = shift;
 
    if (@_) {
        $self->_validate_name( $_[0] );
        $self->{name} = $_[0];
    }
 
    return $self->{name};
}
 
sub birth_date {
    my $self = shift;
 
    if (@_) {
        my $date = $self->_coerce_birth_date( $_[0] );
        $self->_validate_birth_date( $date );
 
        $self->{birth_date} = $date;
    }
 
    return $self->{birth_date};
}

Bitter P5-plain (continued)

sub birth_year {
    my $self = shift;
 
    return $self->birth_date->year;
}
 
sub shirt_size {
    my $self = shift;
 
    if (@_) {
        $self->_validate_shirt_size( $_[0] );
        $self->{shirt_size} = $_[0];
    }
 
    return $self->{shirt_size};
}

Appetizer: Methods

Appetizer: Roles

package Role::Admin::Privileges {
  use Moose::Role;
  requires 'authenticate';
  
  has _privileges => (
    is   => 'ro',
    isa  => enum(qw<sudoer user>),
    lazy => 1
  );
}


package AdminUser {
  use Moose;
  extends 'User';
  with 'Role::Admin::Privileges';

  method authenticate {
    ... # yadda yadda yadda
  }
}

Appetizer: Traits

Appetizer: Getopt

use MooseX::DeclareX;
class Baz with MooseX::Getopt {
    has foo => ( 
        is          => 'rw', 
        isa         => 'Str', 
        traits      => [ 'Getopt' ],
        cmd_aliases => ['f', 'foo'],
        default     => 'foo',
    );
}

package main;
print Baz->new_with_options->foo;

__END__
$ perl Baz.pm
# foo

$ Perl Baz.pm --foo=quux
# quux

$ Perl Baz.pm -f bar
# bar

Appetizer: Method Modifiers

Appetizer: Method Modifiers

Appetizer: Moose extended

use Moops;
 
role NamedThing {
   has name => (is => "ro", isa => Str);
}
 
class Person with NamedThing;
 
class Company with NamedThing;
 
class Employee extends Person {
   has job_title => (is => "rwp", isa => Str);
   has employer  => (is => "rwp", isa => InstanceOf["Company"]);
    
   method change_job (Object $employer, Str $title) {
      $self->_set_job_title($title);
      $self->_set_employer($employer);
   }
    
   method promote (Str $title) {
      $self->_set_job_title($title);
   }
}

Appetizer: Lazyness

Mit lazy lassen sich teure Berechungen auf den spätest-möglichen Zeitpunkt verschieben:

has size => (
    is      => 'ro',
    lazy    => 1,
    builder => '_build_size',
);

method _build_size {
  # heavy stuff...
}

Erweiterungen

Empfehlungen

Moose / Moo / Mouse / Mo / Moos / M / MooseX::Declare / MooseX::DeclareX / Moops?