Objects

Things
that can
Do Things

Data + Behavior

Data:
Attributes

Behavior:
Methods

Class:
Object Blueprint

Constructor: Create Objects From Class

Inheritance:
My Class +
Your Class

Model
View
Controller

Dependency Injection

Extract
Transform
Load

Extract: Get Data

Transform: Modify Data

Load: Store Data

Financial Data

Time Series:
Date/Value Pairs

Data: Reference (\%data)

Behavior: sub

Class: package

Object:
bless \%data, 'package'

Classic Perl Object

package Duke;
sub new {
    my ( $class, %data ) = @_;
    return bless \%data, $class;
}
                

Instantiate an Object

use Duke;
my $duke = Duke->new(
    foo => "bar",
    baz => "fuzz",
);
                

Dereference (->) a bareword: Class method

Class methods get class as first argument

Just a Reference

say $duke->{foo}; # "bar"
say $duke->{baz}; # "fuzz"
                

Breaks Encapsulation!

Blessed

use Scalar::Util qw( blessed );
say ref $duke;      # "Duke=HASH(0xdeadbeef)"
say blessed $duke;  # "Duke"
                

Package name is attached to the reference

Attributes

package Duke;
sub new {
    my ( $class, %args ) = @_;
    return bless {
        src   => $args{src},            # Extract
        xform => $args{xform} || [],    # Transform (optional)
        dest  => $args{dest},           # Load
    }, $class;
}
                

Methods

package Duke;
sub add_xform {
    my ( $self, $new_xform ) = @_;
    push @{ $self->{xform} }, $new_xform;
    return;
}
                

Methods get object ($self) as first argument

Allow appending extra transform steps.

Accessors and Mutators

Methods to get/set attributes

package Duke;
sub src {
    my ( $self ) = @_;
    return $self->{src};
}
sub xform {
    my ( $self ) = @_;
    return $self->{xform};
}
sub dest {
    my ( $self, $new_dest ) = @_;
    if ( $new_dest ) {
        $self->{dest} = $new_dest;
    }
    return $self->{dest};
}
                

Allow new destinations, but not new sources or transforms.

Calling Methods

my $duke = Duke->new(
    src => "NYSE",
    xform => "FindSpikes",
    dest => "MySQL",
);
say $duke->src;
$duke->dest( "Postgres" );
say $duke->dest;
                

Don't let the caller use the reference directly.

Time Series

Data model

package Duke::TimeSeries;
sub new {
    my ( $class, %args ) = @_;
    return bless {
        name => $args{name},    # Descriptive name
        data => $args{data},    # Hashref of date => value pairs
    }, $class;
}
sub name {
    my ( $self ) = @_; # read only
    return $self->{name};
}
sub data {
    my ( $self, $date ) = @_; # read only
    return $self->{data}{$date};
}
                

Mutability allows hard-to-find bugs

Source

Extract Time Series

package Duke::Source;
sub new {
    my ( $class, %args ) = @_;
    return bless \%args, $class;
}
sub read_data {
    my ( $self, $name ) = @_;
    my %data;
    # ...
    return Duke::TimeSeries->new(
        name => $name,
        data => \%data,
    );
}
                

Notice the patterns? We'll do better soon

Destination

Load Time Series

package Duke::Destination;
sub new {
    my ( $class, %args ) = @_;
    return bless \%args, $class;
}
sub write_data {
    my ( $self, $time_series ) = @_;
    # ...
    return;
}
                

Notice the patterns? We'll do better soon

Transform

Get one time series. Return another.

package Duke::Xform;
sub new {
    my ( $class, %args ) = @_;
    return bless \%args, $class;
}
sub xform_data {
    my ( $self, $in_data ) = @_;
    my %out_data;
    # ...
    return Duke::TimeSeries->new(
        name => $in_data->name,
        data => \%out_data,
    );
}
                

Notice the patterns? We'll do better soon

Running The Job

package Duke;
sub run {
    my ( $self, $name ) = @_;
    my $data = $self->src->read_data( $name );
    for my $xform ( @{ $self->xform } ) {
        $data = $xform->xform_data( $data );
    }
    $self->dest->write_data( $data );
    return;
}
                

By Your Powers Combined: ETL

my $duke = Duke->new(
    src => Duke::Source->new(),
    xform => [
        Duke::Xform->new(),
        Duke::Xform->new(),
    ],
    dest => Duke::Destination->new(),
);
$duke->run( 'IBM' );
                

Subclasses

@ISA

our @ISA = ( 'Class' )

use base 'Class'

use parent 'Class'

A Useful Source

Inherits from Duke::Source

package Duke::Source::DBI;
use parent 'Duke::Source';
# new() is inherited
sub read_data {
    my ( $self, $name ) = @_;

    if ( !$self->{_dbh} ) { # Lazy attribute
        $self->{_dbh} = DBI->connect( $self->{dsn}, $self->{db_user}, $self->{db_pass} );
    }

    my $data = $self->{_dbh}->selectall_hashref(
        'SELECT date,value FROM time_series WHERE name=?',
        'date', # the field used for keys
        {},
        [ $name ]
    );

    return Duke::TimeSeries->new(
        name => $name,
        data => $data,
    );
}
                

Using Subclasses

Duke::Source::DBI is a subclass of Duke::Source

use Duke::Source::DBI;
my $src = Duke::Source::DBI->new(
    dsn => '...',
    db_user => 'user',
    db_pass => '***',
);
say blessed $src;
say $src->isa( 'Duke::Source' ) ? 'Yes' : 'No';
say $src->DOES( 'Duke::Source' ) ? 'Yes' : 'No';
                

Only You Can Prevent Runtime Errors

my $duke = Duke->new(
    src => Duke::Destination->new(), # Uhoh
    # no dest?
);
# ... 200 lines in 20 files omitted
$duke->run(); # BOOM!
                

Type Checking

package Duke;
sub new {
    my ( $class, %args ) = @_;

    die "src is required and must be Duke::Source object"
        unless blessed( $args{src} ) && $args{src}->isa( 'Duke::Source' );
    die "dest is required and must be Duke::Destination object"
        unless blessed( $args{dest} ) && $args{dest}->isa( 'Duke::Destination' );
    if ( $args{xform} ) {
        die "xform must be arrayref of Duke::Xform objects"
            if ref $args{xform} ne 'ARRAY'
                || grep {
                    !blessed( $_ ) || !$_->isa( 'Duke::Xform' )
                } @{ $args{xform} }
                ;
    }

    return bless {
        src   => $args{src},            # Extract
        xform => $args{xform} || [],    # Transform (optional)
        dest  => $args{dest},           # Load
    }, $class;
}
                

In Subclasses

Override a method with SUPER::

package Duke::Source::DBI;
use parent 'Duke::Source';
sub new {
    my ( $class, %args ) = @_;
    die "dsn is required" unless $args{dsn};
    die "db_user is required" unless $args{db_user};
    die "db_pass is required" unless $args{db_pass};
    my $self = $class->SUPER::new( %args );
    return $self;
}
                

Repeat

Repeat

Repeat

There's More Than One Way To Do It

There Must Be a Better Way...

Modern OO

Earl ETL

Attributes

has( 'attr', %args )

package Earl;
use Moo;
has src => (
    is => 'ro',
    required => 1,
    isa => sub {
        my ( $src ) = @_;
        die "src must be Earl::Source object"
            unless blessed $src && $src->isa( 'Earl::Source' );
    },
);
has dest => (
    is => 'rw',
    required => 1,
    isa => sub {
        my ( $dest ) = @_;
        die "dest must be Earl::Destination object"
            unless blessed $dest && $dest->isa( 'Earl::Destination' );
    },
);
has xform => (
    is => 'ro',
    default => sub { [] },
    isa => sub {
        my ( $xform ) = @_;
        die "xform must be arrayref of Earl::Xform objects"
            if ref $xform ne 'ARRAY'
                || grep {
                    !blessed( $_ ) || !$_->isa( 'Earl::Xform' )
                } @{ $xform }
                ;
    },
);
                

Moo Automatically...

• Creates a constructor
• Checks for required attributes
• Runs the type checks
• Sets defaults for optional attributes
• Creates read-only accessors
• Creates read-write mutators

Reduced 40 lines to 15

Subclasses

package Earl::Source::DBI;
use Moo;
extends 'Earl::Source';
has dsn => (
    is => 'ro',
    required => 1,
);
has db_user => (
    is => 'ro',
    required => 1,
);
has db_pass => (
    is => 'ro',
);
                

extends() adds to @ISA

Lazy Attributes

package Earl::Source::DBI;
has _dbh => (
    is => 'ro',
    lazy => 1,
    default => sub {
        my ( $self ) = @_;
        return DBI->connect( $self->{dsn}, $self->{db_user}, $self->{db_pass} );
    },
);
sub read_data {
    my ( $self, $name ) = @_;

    my $data = $self->_dbh->selectall_hashref(
        'SELECT date,value FROM time_series WHERE name=?',
        'date', # the field used for keys
        {},
        [ $name ]
    );

    return Earl::TimeSeries->new(
        name => $name,
        data => $data,
    );
}
                

Builds the default when requested

Readability: Describe the what, not the how

Better Type Constraints

package Earl;
use Moo;
use Types::Standard qw( :all );
has src => (
    is => 'ro',
    required => 1,
    isa => InstanceOf['Earl::Source'],
);
has dest => (
    is => 'rw',
    required => 1,
    isa => InstanceOf['Earl::Destination'],
);
has xform => (
    is => 'ro',
    default => sub { [] },
    isa => ArrayRef[ InstanceOf['Earl::Xform'] ],
);
                

Saved 12 lines of code

Much more readable: What, not How

Roles > Inheritance

Multiple Roles > Multiple Inheritance

Roles as Interface

Source Role

package Earl::Source;
use Moo::Role;
requires 'read_data';
                

Checks for a read_data method

Method Modifiers

Run a method before, after, or around another method

package Earl::Source;
use Moo::Role;
requires 'read_data';
before read_data => sub {
    my ( $self, $name ) = @_;
    die "name is required" unless $name;
};
                

around() Modifier

package Earl::Xform;
use Moo::Role;
requires 'xform_data';
around xform_data => sub {
    my ( $orig, $self, $in_data ) = @_;

    die "input data must be Earl::TimeSeries"
        unless blessed $in_data && $in_data->isa( 'Earl::TimeSeries' );

    my $out_data = $self->$orig( $in_data );

    die "output data must be Earl::TimeSeries"
        unless blessed $out_data && $out_data->isa( 'Earl::TimeSeries' );

    return $out_data;
};
                

Meta-Object Protocol

Class Objects

Inspect and Alter Classes at Runtime

Moo Becomes Moose

Work With Attributes

use Earl;
for my $attr ( Earl->meta->get_all_attributes ) {
    say $attr->name;
}
Earl->meta->add_attribute( 'foo', is => 'ro' );
my $earl = Earl->new( foo => 'FOO!' );
say $earl->foo;
                

See Moose::Meta::Class and Class::MOP::Class

Modify Methods

use Earl;
Earl->meta->add_after_method_modifier( run => sub { say "DONE!" } );
my $earl = Earl->new( ... );
$earl->run;
                

See Moose::Meta::Class and Class::MOP::Class

Only Change an Instance

use Earl;
my $earl = Earl->new( ... );
$earl->meta->add_attribute( 'foo', is => 'rw' );
$earl->foo( "FOO!" );
say $earl->foo;
                

See Moose::Meta::Class and Class::MOP::Class

Everything's Possible

• Create a new class
• ... that extends an existing class
• ... and add a role to the new class
• ... modify some methods
• ... and add some attributes
• All at runtime

Compose your classes with configuration

Class Sugar

Cutting Edge!

Provided Without Endorsement

class Function

use Moops;
class Jester {
    has src => (
        is => 'ro',
        required => 1,
        isa => ConsumerOf['Jester::Source'],
    );
    has dest => (
        is => 'rw',
        required => 1,
        isa => ConsumerOf['Jester::Destination'],
    );
    has xform => (
        is => 'ro',
        default => sub { [] },
        isa => ArrayRef[ ConsumerOf['Jester::Xform'] ],
    );
    method run ( Str $name ) {
        my $data = $self->src->read_data( $name );
        for my $xform ( @{ $self->xform } ) {
            $data = $xform->xform_data( $data );
        }
        $self->dest->write_data( $data );
        return;
    }
}
            

Assignable Methods

package Earl;
use Moo;
use MooX::LvalueAttribute;
use Types::Standard qw( :all );
has dest => (
    is => 'rw',
    required => 1,
    isa => ConsumerOf['Earl::Destination'],
    lvalue => 1,
);

package main;
my $earl = Earl->new( ... );
$earl->dest = Earl::Destination->new( ... );
                

Data Not In the Reference

package Earl::InsideOut;
use Scalar::Util qw( refaddr );
my %sources;
sub src {
    my ( $self ) = @_;
    my $src = $sources{ refaddr $self };
    return $src;
}
                

Can prevent memory leaks by breaking cycles

Sub Signatures

package Earl;
use experimental qw( signatures );
sub add_xform( $self, $new_xform ) {
    push @{ $self->xform }, $new_xform;
    return;
}