Perl 5 MOP Stevan Little ● YAPC::EU 2012 ● Frankfurt, Germany Wednesday ● 22 August 2012 So I have been kicking around some Larry quotes in talks recently. And I decided I wanted to show 3 of my favorites here. But before I did this I asked Larry about each one (mostly to be sure he really said them).
Perl was always designed to be an evolving language. – Larry Wall So I asked Larry about this one he told me basically that “adding sigils to variables allowed for builtins to be added and not conflict with variables” , just think about that for a moment. Cool right?
Perl 5 was my rewrite of Perl. I want Perl 6 to be the community's rewrite of Perl and of the community. – Larry Wall When I parse this sentence, I only find one community
The whole intent of Perl 5's module system was to encourage the growth of Perl culture rather than the Perl core. – Larry Wall * Historical tidbit: Perl 4 had oraperl, etc, which split the community, Larry saw this and didnt want this to happen, so saw that modules were critical way to allowed the community to be lexically scoped * I think this conference and the others like it, YAPCs and Workshops and Mongers groups are an example of the success of this plan.
last summer Jesse Vincent gave this talk at ... YAPC::NA, then again at YAPC::EU, then at OSCON, and then at YAPC::Asia, Jesse gave this talk and said a lot of interesting things.
“Perl 5.16 and Beyond” by Jesse Vincent last summer Jesse Vincent gave this talk at ... YAPC::NA, then again at YAPC::EU, then at OSCON, and then at YAPC::Asia, Jesse gave this talk and said a lot of interesting things.
“Perl 5.16 and Beyond” by Jesse Vincent ‣@yapc::na last summer Jesse Vincent gave this talk at ... YAPC::NA, then again at YAPC::EU, then at OSCON, and then at YAPC::Asia, Jesse gave this talk and said a lot of interesting things.
“Perl 5.16 and Beyond” by Jesse Vincent ‣@yapc::na ‣@yapc::eu last summer Jesse Vincent gave this talk at ... YAPC::NA, then again at YAPC::EU, then at OSCON, and then at YAPC::Asia, Jesse gave this talk and said a lot of interesting things.
“Perl 5.16 and Beyond” by Jesse Vincent ‣@yapc::na ‣@yapc::eu ‣@oscon last summer Jesse Vincent gave this talk at ... YAPC::NA, then again at YAPC::EU, then at OSCON, and then at YAPC::Asia, Jesse gave this talk and said a lot of interesting things.
“Perl 5.16 and Beyond” by Jesse Vincent ‣@yapc::na ‣@yapc::eu ‣@oscon ‣@yapc::asia last summer Jesse Vincent gave this talk at ... YAPC::NA, then again at YAPC::EU, then at OSCON, and then at YAPC::Asia, Jesse gave this talk and said a lot of interesting things.
Core ↝ Modules the idea put forth was to move things into modules, where they can be loaded as needed, but not burden the core perl-guts with them. I used this neat unicode wavy arrow because there is a certain amount of handwaving here. Largely because he also talks about preserving past version semantics and other not so simple things.
Classes, Methods, Attributes & Instances MOP is just an API for these things. Note the uppercase, it is important. Class is not the same thing as class.
... an abstraction of a system of abstractions that is used to build abstractions. So, when my mother asks me “what is all this Moose stuff you do”, this is what I tell her.
*{$pkg . '::foo'} = \&bar; this is the original MOP, little akward in places, but it works. I know this because i had to use this MOP to write Moose with!
So this is actually a picture of the p5-mop meta-layer. We are side stepping Module and Package for the moment so that we can focus on the class layer. However we might just keep it this way since tools like Package::Stash exist
class Point { has $x = 0; has $y = 0; method clear { ($x, $y) = (0, 0); } } method keyword - the attributes are available in methods as lexical variables - the scope of them being carried around in the instance - the destructuring bind in the clear method
my $point = Point->new( x => 10, y => 20 ); - constructor takes name/value pairs of the attributes (reasonably good default that can be changed via the MOP)
class BankAccount { has $balance ( is => 'ro' ) = 0; method deposit ($amount) { $balance += $amount } method withdraw ($amount) { die "Account overdrawn" if ($balance <= $amount); $balance -= $amount; } } build in support for ro, rw and wo accessors (TODO) - this is actually a metadata expression - which is like annotations (Java), attributes (C//), decorators (Python) - it is executed at compile time and passed to the meta object being created - setting the default values of attributes
class BankAccount { has $balance ( is => 'ro' ) = 0; method deposit ($amount) { $balance += $amount } method withdraw ($amount) { die "Account overdrawn" if ($balance <= $amount); $balance -= $amount; } } Isn’t it nice how clean the += and -= makes things
class BankAccount { has $balance ( is => 'ro' ) = 0; method deposit ($amount) { # $self->balance( # $self->balance + $amount # ); $balance += $amount } method withdraw ($amount) { # my $balance = $self->balance; die "Account overdrawn" if ($balance <= $amount); # $self->balance( $balance + $amount ); $balance -= $amount; } } And guess what, that is 4 less method calls - note there is no reference to $self in this entire class
class CheckingAccount (extends => BankAccount) { has $overdraft_account ( is => 'rw' ); method withdraw ($amount) { my $overdraft_amount = $amount - $self->balance; if ( $overdraft_account && $overdraft_amount > 0 ) { $overdraft_account->withdraw( $overdraft_amount ); $self->deposit( $overdraft_amount ); } super( $amount ); } } Make a note here about where we differ from Moose, in Moose the super call will actually pass @_ through for you and not allow you to change it. Here actually w do do that, this actually behaves much more like SUPER pseudo package , you have to pass variables down yourself
role Equality { method equal_to; method not_equal_to ($other) { not $self->equal_to($other); } } we also have roles, horray! - apply this role to something you might wish to be able to test equality
role Equality { method equal_to; method not_equal_to ($other) { not $self->equal_to($other); } } and we supply one method, which just negates the equal_to check that a consuming client will be required to implement
role Comparable (with => Equality) { method compare; method equal_to ($other) { $self->compare($other) == 0 } method greater_than ($other) { $self->compare($other) == 1 } method less_than ($other) { $self->compare($other) == -1 } } here, we add one more required method, and again implement the role in terms of that method
class DE::Currency (with => [ Comparable, Printable ]) { has $amount ( is => 'rw' )= 0; method compare ($other) { $amount <=> $other->amount } method as_string { sprintf '€ %0.2f' => $amount } } and we are implementing the compare from the Comparable role
package Foo; use strict; use warnings; class Bar { has $baz; method foo { $baz } } packages can contain classes - because classes are first class citizens just like subs, etc. - this is much like other langauges (Java, etc) - classes don't need strict and warnings - it would be on by default
package MyApp::Reports; use strict; use warnings; our $CONFIG = MyApp::Config->load; sub create_dbh { ... } class Finance { has $money_to_make = 10_000_000; method create_report { my $dbh = create_dbh; # ... $self->print_report( $CONFIG ); } } - the class has access to the package scope as well
package MyApp::Reports; use strict; use warnings; our $CONFIG = MyApp::Config->load; sub create_dbh { ... } class Finance { has $money_to_make = 10_000_000; method create_report { my $dbh = create_dbh; # ... $self->print_report( $CONFIG ); } } - this means static class scoped data is simple
package MyApp::Reports; use strict; use warnings; our $CONFIG = MyApp::Config->load; sub create_dbh { ... } class Finance { has $money_to_make = 10_000_000; method create_report { my $dbh = create_dbh; # ... $self->print_report( $CONFIG ); } } - this means you can have subs that are not part of the class namespace
package MyApp::Reports; use strict; use warnings; our $CONFIG = MyApp::Config->load; my sub create_dbh { ... } class Finance { has $money_to_make = 10_000_000; method create_report { my $dbh = create_dbh; # ... $self->print_report( $CONFIG ); } } And, likely in 5.18 or 5.20, there will be private subs, so now you have private subs, they are not methods, but they are inaccessible from outside of the package and they are not part of the class’s dispatch space
package DB::FlatFile; use Path::Class qw[ file ]; class DataFile { has $path; has $file; has $data ( is => 'ro' ); BUILD { $file = file( $path ); $data = [ $file->slurp(chomp => 1) ]; } } Here is an example of using this with exported functions
package DB::FlatFile; use Path::Class qw[ file ]; class DataFile { has $path; has $file; has $data ( is => 'ro' ); BUILD { $file = file( $path ); $data = [ $file->slurp(chomp => 1) ]; } } - import functions into your package, - this removes the need to import anything into your class namespace. - no more namespace::clean hacks
package DB::FlatFile; use Path::Class qw[ file ]; class DataFile { has $path; has $file; has $data ( is => 'ro' ); BUILD { $file = file( $path ); $data = [ $file->slurp(chomp => 1) ]; } } - this also shows BUILD - works mostly just like Moose does (the dispatch order anyway) - however both BUILD and DEMOLISH are not in the dispatch path (which is a good thing)
use Fun; fun fibonacci ( $i ) { given ( $i ) { when ( $i == 0 ) { 0 } when ( $i == 1 ) { 1 } default { fibonacci( $i - 1 ) + fibonacci( $i - 2 ) } } } Before I go into the next example, I want to show ... Fun
use Fun; fun convert_error ($err, $handle) { given ( $err ) { when ( qr/^No such file or directory/ ) { Err::NotFound->new( handle => $handle )->throw } when ( qr/^Permission denied/ ) { Err::PermissionsDenied->new( handle => $handle )->throw } default { warn $err if $err } } } class FileHandle { has $mode ( is => 'ro' ); has $filename ( is => 'ro' ); has $fh; BUILD ($params) { $fh = IO::File->new( $self->filename, $self->mode ) or convert_error( $!, $self ); } DEMOLISH { $fh->close or convert_error( $!, $self ) if $fh; } } Here is another example of working with older Perl modules, in this case capaturing and converting the errors from IO::File
use Fun; fun convert_error ($err, $handle) { given ( $err ) { when ( qr/^No such file or directory/ ) { Err::NotFound->new( handle => $handle )->throw } when ( qr/^Permission denied/ ) { Err::PermissionsDenied->new( handle => $handle )->throw } default { warn $err if $err } } } class FileHandle { has $mode ( is => 'ro' ); has $filename ( is => 'ro' ); has $fh; BUILD ($params) { $fh = IO::File->new( $self->filename, $self->mode ) or convert_error( $!, $self ); } DEMOLISH { $fh->close or convert_error( $!, $self ) if $fh; } } Basically this is a utility function, private to the class (presumably this is in a package somewhere).
use Fun; my fun convert_error ($err, $handle) { given ( $err ) { when ( qr/^No such file or directory/ ) { Err::NotFound->new( handle => $handle )->throw } when ( qr/^Permission denied/ ) { Err::PermissionsDenied->new( handle => $handle )->throw } default { warn $err if $err } } } class FileHandle { has $mode ( is => 'ro' ); has $filename ( is => 'ro' ); has $fh; BUILD ($params) { $fh = IO::File->new( $self->filename, $self->mode ) or convert_error( $!, $self ); } DEMOLISH { $fh->close or convert_error( $!, $self ) if $fh; } } And as soon as the my sub stuff is done, I am sure we can expect this
use Fun; fun convert_error ($err, $handle) { given ( $err ) { when ( qr/^No such file or directory/ ) { Err::NotFound->new( handle => $handle )->throw } when ( qr/^Permission denied/ ) { Err::PermissionsDenied->new( handle => $handle )->throw } default { warn $err if $err } } } class FileHandle { has $mode ( is => 'ro' ); has $filename ( is => 'ro' ); has $fh; BUILD ($params) { $fh = IO::File->new( $self->filename, $self->mode ) or convert_error( $!, $self ); } DEMOLISH { $fh->close or convert_error( $!, $self ) if $fh; } } So what this function is doing then is converting string errors from IO::File to be exceptions (again note the smart match usage)
use Devel::StackTrace; role Throwable { has $message ( is => 'ro' ) = 'Error'; has $stack_trace ( is => 'ro' ) = Devel::StackTrace->new( frame_filter => sub { ... } ); method throw { die $self } method format_message ( $message ) { "$message" } method as_string { $self->format_message( $message ) . "\n" . $stack_trace->as_string } } Here is the actual role those two exceptions came from. Basically this is porting RJBS’s module Throwable (sorta, I simplified it a little for the slide) It nicely shows that it is also possible to use p5-mop and p5 classes together, the simplest is delgation, (though we do want to make inheritance work)
use Devel::StackTrace; role Throwable { has $message ( is => 'ro' ) = 'Error'; has $stack_trace ( is => 'ro' ) = Devel::StackTrace->new( frame_filter => sub { ... } ); method throw { die $self } method format_message ( $message ) { "$message" } method as_string { $self->format_message( $message ) . "\n" . $stack_trace->as_string } } here we are using the p5 OO module called Devel::StackTrace
use Devel::StackTrace; role Throwable { has $message ( is => 'ro' ) = 'Error'; has $stack_trace ( is => 'ro' ) = Devel::StackTrace->new( frame_filter => sub { ... } ); method throw { die $self } method format_message ( $message ) { "$message" } method as_string { $self->format_message( $message ) . "\n" . $stack_trace->as_string } } here is the throw method, which is not a class method, so you must do ->new->throw. However this is how it working in many popular languages
use Devel::StackTrace; role Throwable { has $message ( is => 'ro' ) = 'Error'; has $stack_trace ( is => 'ro' ) = Devel::StackTrace->new( frame_filter => sub { ... } ); method throw { die $self } method format_message ( $message ) { "$message" } method as_string { $self->format_message( $message ) . "\n" . $stack_trace->as_string } } we do not yet have overloading though, so for now you call the as_string method instead
use Devel::StackTrace; role Throwable (with => [ Printable ]) { has $message ( is => 'ro' ) = 'Error'; has $stack_trace ( is => 'ro' ) = Devel::StackTrace->new( frame_filter => sub { ... } ); method throw { die $self } method format_message ( $message ) { "$message" } method as_string { $self->format_message( $message ) . "\n" . $stack_trace->as_string } } And you know what, since we have as_string, we might as well make this Printable (our role from the Previous slide) so that people can do this ...
use Try; try { # ... } catch { when ( Printable ) { warn $_->as_string; } default { warn $_; } } this basically means that code like this is doable ...
use Try; try { # ... } catch { when ( Printable ) { warn $_->as_string; } default { warn $_; } } Note that this doesn’t say Try::Tiny, it says Try, this is because earlier this week Jesse Luehrs released it. It basically uses the Devel::CallParser module to implement a language level try/catch/finally statement.
use Try; try { # ... } catch { when ( Printable ) { warn $_->as_string; } default { warn $_; } } this means you have a language level try/catch/finally construct. Currently this is backed by Try::Tiny, but Jesse and Florian are both working on fixing that (as well as making return to do the right thing inside a try).
use Try; try { # ... } catch { when ( Printable ) { warn $_->as_string; } default { warn $_; } } this means you have a language level try/catch/finally construct. Currently this is backed by Try::Tiny, but Jesse and Florian are both working on fixing that (as well as making return to do the right thing inside a try).
use Try; try { # ... } catch { when ( Printable ) { warn $_->as_string; } default { warn $_; } } My favorite part though is the use of when in the catch block. Note that this likely wouldn’t work straight away, you will need to do ...
use Try; try { # ... } catch { when ( $_->does( Printable ) ) { warn $_->as_string; } default { warn $_; } } this, but if the recent smartmatch proposal from RJBS goes through, we should be able to do it
http://github.com/stevan/p5-mop/ Okay, and thats pretty much about it ... I want to remind everyone, almost all of these examples (other then the exceptions I mentioned) is actual runnable code. If you go to github you can check it out and try it (and please write tests)
stevan_little
niftycorp
uhooi
mugi_uno
aridlehoover
texmeijin
mot_techtalk
clown0082
zakky21
ivanova1991
yusukebe
skanehira
62gerente
thekraken
sachag
rocio
dotmariusz
morganepeng
holman
caitiem20
akmur
jcasabona
shlominoach
carmenintech