Core, Moo, and Moose
Doug Bell - Bank of America
\%data
)sub
package
bless \%data, 'package'
package Duke;
sub new {
my ( $class, %data ) = @_;
return bless \%data, $class;
}
use Duke;
my $duke = Duke->new(
foo => "bar",
baz => "fuzz",
);
Dereference (->
) a bareword: Class method
Class methods get class as first argument
say $duke->{foo}; # "bar"
say $duke->{baz}; # "fuzz"
Breaks Encapsulation!
use Scalar::Util qw( blessed );
say ref $duke; # "Duke=HASH(0xdeadbeef)"
say blessed $duke; # "Duke"
Package name is attached to the reference
package Duke;
sub new {
my ( $class, %args ) = @_;
return bless {
src => $args{src}, # Extract
xform => $args{xform} || [], # Transform (optional)
dest => $args{dest}, # Load
}, $class;
}
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.
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.
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.
Objectify All The Things
Build an API
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
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
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
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
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;
}
my $duke = Duke->new(
src => Duke::Source->new(),
xform => [
Duke::Xform->new(),
Duke::Xform->new(),
],
dest => Duke::Destination->new(),
);
$duke->run( 'IBM' );
@ISA
our @ISA = ( 'Class' )
use base 'Class'
use parent 'Class'
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,
);
}
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';
my $duke = Duke->new(
src => Duke::Destination->new(), # Uhoh
# no dest?
);
# ... 200 lines in 20 files omitted
$duke->run(); # BOOM!
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;
}
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;
}
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 }
;
},
);
Reduced 40 lines to 15
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
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
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
package Earl::Source;
use Moo::Role;
requires 'read_data';
Checks for a read_data method
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;
};
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;
};
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
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
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
Compose your classes with configuration
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;
}
}
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( ... );
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
package Earl;
use experimental qw( signatures );
sub add_xform( $self, $new_xform ) {
push @{ $self->xform }, $new_xform;
return;
}
/