Intro to MOP (presented at YAPC::NA)

Intro to MOP (presented at YAPC::NA)

0599bca0a7a5365993135af90236779d?s=128

Upasana

June 22, 2016
Tweet

Transcript

  1. Meta Object Protocol (MOP) Upasana me@upasana.me

  2. About me • Software developer at booking.com

  3. We are hiring https://workingatbooking.com/

  4. Backstory • GNOME Outreach Program for Women internship in 2013

    • Structured exceptions in Moose • Want to share whatever I learnt during my internship
  5. Topics 1) Little bit about object oriented programming (OOP) 2)

    Little bit about OOP in perl (the old style) 3) Meta object protocol (MOP) 4) History of MOP 5) Applications of MOP
  6. Topics 6) Implementing MOP in Perl (the easy way) 7)

    Why #6 might not be a good idea 8) Metaclass incompatibility 9) Mixins 10) MOP in Moose 11) Drawbacks of MOP 12) Where to go next?
  7. How a class looks like? • Class name • Superclasses

  8. How a class looks like? • Attributes – is read

    only or read-write – type (int, float etc.) – default value if any – getter method (accessor) – setter method (mutator)
  9. How a class looks like? • Methods – method name

    – body
  10. Classes in Perl • Perl doesn't provide any special syntax

    for classes • Perl packages are classes
  11. Attributes in Perl classes • No special syntax or support

    for declaring and manipulating attributes • Attributes are stored in the object itself • As a hash of key-value pairs
  12. Object? • A hash reference • blessed into a class

  13. OOP in Perl package Rectangle; sub new { my $self

    = shift; my $attributes = { @_ }; bless $attributes, $self; } Rectangle->new( height => 10, width => 20, );
  14. OOP in Perl package Rectangle; sub new { my $self

    = shift; my $attributes = { @_ }; bless $attributes, $self; } Rectangle->new( height => 10, width => 20, );
  15. OOP in Perl package Rectangle; sub new { my $self

    = shift; my $attributes = { @_ }; bless $attributes, $self; } Rectangle->new( height => 10, width => 20, );
  16. OOP in Perl package Rectangle; sub new { my $self

    = shift; my $attributes = { @_ }; bless $attributes, $self; } Rectangle->new( height => 10, width => 20, );
  17. OOP in Perl package Rectangle; sub new { my $self

    = shift; my $attributes = { @_ }; bless $attributes, $self; } Rectangle->new( height => 10, width => 20, );
  18. OOP in Perl package Rectangle; sub new { my $self

    = shift; my $attributes = { @_ }; bless $attributes, $self; } Rectangle->new( height => 10, width => 20, );
  19. OOP in Perl package Rectangle; sub new { my $self

    = shift; my $attributes = { @_ }; bless $attributes, $self; } Rectangle->new( height => 10, width => 20, );
  20. What is MOP? • provides the vocabulary to access and

    manipulate the structure and behavior of objects.
  21. Functions of MOP • Creating new classes • Deleting existing

    classes • Changing the class structure • Changing methods of the class • At runtime
  22. History of MOP • First introduced in the Smalltalk •

    Common LISP Object System (CLOS) was influenced by Smalltalk • CLOS allowed multiple inheritance unlike Smalltalk
  23. MOP in modern languages • Javascript has Joose • OpenC++

    • Java has Reflection API • Perl has Moose
  24. Why do we need a MOP?

  25. Testing

  26. Testing • I work at booking.com • Our website is

    moving very fast • Many rollouts in a day
  27. Testing • We don't test everything • At one point,

    rollouts became hard • Some things need to be tested manually
  28. Testing package Web::Handler { has 'search' => ( url =>

    '/search', #... ); has 'hotel' => ( url => '/hotel', #... ); # ... }
  29. Testing package Web::Handler { has 'search' => ( url =>

    '/search', #... ); has 'hotel' => ( url => '/hotel', #... ); # ... }
  30. Testing package Web::Handler { has 'search' => ( url =>

    '/search', #... ); has 'hotel' => ( url => '/hotel', #... ); # ... }
  31. Testing • Give me all the attributes of Web::Handler. •

    Run tests for all the attributes.
  32. Testing # This is pseudocode, don't expect this # to

    compile my $attr = Web::Handler->meta->get_attributes_list; foreach my $a ( @$attr ) { next unless $a->attribute_exists('url'); my $url = $a->get_attribute('url'); die “test fails...\n” if( !LWP::Simple::get($url) ); }
  33. Testing # This is pseudocode, don't expect this # to

    compile my $attr = Web::Handler->meta->get_attributes_list; foreach my $a ( @$attr ) { next unless $a->attribute_exists('url'); my $url = $a->get_attribute('url'); die “test fails...\n” if( !LWP::Simple::get($url) ); }
  34. Testing # don't expect this to compile my $attr =

    Web::Handler->meta->get_attributes_list; foreach my $a ( @$attr ) { next unless $a->attribute_exists('url'); my $url = $a->get_attribute('url'); die “test fails...\n” if( !LWP::Simple::get($url) ); }
  35. Testing # don't expect this to compile my $attr =

    Web::Handler->meta->get_attributes_list; foreach my $a ( @$attr ) { next unless $a->attribute_exists('url'); my $url = $a->get_attribute('url'); die “test fails...\n” if( !LWP::Simple::get($url) ); }
  36. Testing # don't expect this to compile my $attr =

    Web::Handler->meta->get_attributes_list; foreach my $a ( @$attr ) { next unless $a->attribute_exists('url'); my $url = $a->get_attribute('url'); die “test fails...\n” if( !LWP::Simple::get($url) ); }
  37. Testing # don't expect this to compile my $attr =

    Web::Handler->meta->get_attributes_list; foreach my $a ( @$attr ) { next unless $a->attribute_exists('url'); my $url = $a->get_attribute('url'); die “test fails...\n” if( !LWP::Simple::get($url) ); }
  38. Object Relational Mapping (ORM)

  39. ORM my $create_table_statement =<<END; CREATE TABLE Hotel ( id INT

    PRIMARY KEY, name VARCHAR(255), address VARCHAR(255) ); END
  40. ORM my $sql_parser = SQL::Parser->new( $create_table_statement ); my $class_name =

    $sql_parser->table_name; my $c = Moose::Meta::Class->create( $class_name );
  41. ORM my $sql_parser = SQL::Parser->new( $create_table_statement ); my $class_name =

    $sql_parser->table_name; my $c = Moose::Meta::Class->create( $class_name );
  42. ORM my $sql_parser = SQL::Parser->new( $create_table_statement ); my $class_name =

    $sql_parser->table_name; my $c = Moose::Meta::Class->create( $class_name );
  43. ORM my $sql_parser = SQL::Parser->new( $create_table_statement ); my $class_name =

    $sql_parser->table_name; my $c = Moose::Meta::Class->create( $class_name );
  44. ORM foreach my $f ( $sql_parser->fields ) { my $tc

    = find_type_constraint( $f->type ); $c->add_attribute( Moose::Meta::Attribute->new( $f->name, isa => $tc, reader => 'get_' . $f->name, writer => 'set_' . $f->name, ); ); }
  45. ORM foreach my $f ( $sql_parser->fields ) { my $tc

    = find_type_constraint( $f->type ); $c->add_attribute( Moose::Meta::Attribute->new( $f->name, isa => $tc, reader => 'get_' . $f->name, writer => 'set_' . $f->name, ); ); }
  46. ORM foreach my $f ( $sql_parser->fields ) { my $tc

    = find_type_constraint( $f->type ); $c->add_attribute( Moose::Meta::Attribute->new( $f->name, isa => $tc, reader => 'get_' . $f->name, writer => 'set_' . $f->name, ); ); }
  47. ORM foreach my $f ( $sql_parser->fields ) { my $tc

    = find_type_constraint( $f->type ); $c->add_attribute( Moose::Meta::Attribute->new( $f->name, isa => $tc, reader => 'get_' . $f->name, writer => 'set_' . $f->name, ); ); }
  48. ORM foreach my $f ( $sql_parser->fields ) { my $tc

    = find_type_constraint( $f->type ); $c->add_attribute( Moose::Meta::Attribute->new( $f->name, isa => $tc, reader => 'get_' . $f->name, writer => 'set_' . $f->name, ); ); }
  49. ORM foreach my $f ( $sql_parser->fields ) { my $tc

    = find_type_constraint( $f->type ); $c->add_attribute( Moose::Meta::Attribute->new( $f->name, isa => $tc, reader => 'get_' . $f->name, writer => 'set_' . $f->name, ); ); }
  50. ORM foreach my $f ( $sql_parser->fields ) { my $tc

    = find_type_constraint( $f->type ); $c->add_attribute( Moose::Meta::Attribute->new( $f->name, isa => $tc, reader => 'get_' . $f->name, writer => 'set_' . $f->name, ); ); }
  51. ORM package SomeDB::Class::Thing; ..... sub retrieve { .... } sub

    search_where {....} 1; $c->set_superclass( 'SomeDB::Class::Thing' );
  52. ORM # return me the hotel with id 123 my

    $h = Hotel->retrieve( 123 ); my $hotel_name = $h->name; $h->set_name( 'asdfasdf' );
  53. ORM # return me the hotel with id 123 my

    $h = Hotel->retrieve( 123 ); # return me the hotel id 123 my $hotel_name = $h->name; $h->set_name( 'asdfasdf' );
  54. ORM # return me the hotel with id 123 my

    $h = Hotel->retrieve( 123 ); # return me the hotel id 123 my $hotel_name = $h->name; $h->set_name( 'asdfasdf' );
  55. Implementing MOP in Perl

  56. Creating a class at runtime • Perl class is a

    package • Every package has a symbol table
  57. Symbol table • Hash of subroutines/variables defined in a package

    • package name with two colons appended $Rectangle::
  58. Symbol table • Hash of subroutines/variables defined in a package

    • package name with two colons appended $Rectangle::
  59. package Metaclass; sub create_class { my ($self, %options) = @_;

    my $class = $options{ package }; my $methods = $options{ methods }; while( my ($method, $body) = each( %$methods ) ) { no strict 'refs'; *{ "${class}::$method" } = $body; } # end while loop } 1;
  60. package Metaclass; sub create_class { my ($self, %options) = @_;

    my $class = $options{ package }; my $methods = $options{ methods }; while( my ($method, $body) = each( %$methods ) ) { no strict 'refs'; *{ "${class}::$method" } = $body; } # end while loop } 1;
  61. package Metaclass; sub create_class { my ($self, %options) = @_;

    my $class = $options{ package }; my $methods = $options{ methods }; while( my ($method, $body) = each( %$methods ) ) { no strict 'refs'; *{ "${class}::$method" } = $body; } # end while loop } 1;
  62. package Metaclass; sub create_class { my ($self, %options) = @_;

    my $class = $options{ package }; my $methods = $options{ methods }; while( my ($method, $body) = each( %$methods ) ) { no strict 'refs'; *{ "${class}::$method" } = $body; } # end while loop } 1;
  63. package Metaclass; sub create_class { my ($self, %options) = @_;

    my $class = $options{ package }; my $methods = $options{ methods }; while( my ($method, $body) = each( %$methods ) ) { no strict 'refs'; *{ "${class}::$method" } = $body; } # end while loop } 1;
  64. package Metaclass; sub create_class { my ($self, %options) = @_;

    my $class = $options{ package }; my $methods = $options{ methods }; while( my ($method, $body) = each( %$methods ) ) { no strict 'refs'; *{ "${class}::$method" } = $body; } # end while loop } 1;
  65. package Metaclass; sub create_class { my ($self, %options) = @_;

    my $class = $options{ package }; my $methods = $options{ methods }; while( my ($method, $body) = each( %$methods ) ) { no strict 'refs'; *{ "${class}::$method" } = $body; } # end while loop } 1;
  66. package Metaclass; sub create_class { my ($self, %options) = @_;

    my $class = $options{ package }; my $methods = $options{ methods }; while( my ($method, $body) = each( %$methods ) ) { no strict 'refs'; *{ "${class}::$method" } = $body; } # end while loop } 1;
  67. Metaclass->create_class( package => 'Rectangle', methods => { new => sub

    { my ($self) = shift; my $attributes = { @_ }; return bless $attributes, $self; }, } ); Rectangle->new( height => 10, Width => 20 );
  68. Metaclass->create_class( package => 'Rectangle', methods => { new => sub

    { my ($self) = shift; my $attributes = { @_ }; return bless $attributes, $self; }, } ); Rectangle->new( height => 10, Width => 20 );
  69. Metaclass->create_class( package => 'Rectangle', methods => { new => sub

    { my ($self) = shift; my $attributes = { @_ }; return bless $attributes, $self; }, } ); Rectangle->new( height => 10, Width => 20 );
  70. Metaclass->create_class( package => 'Rectangle', methods => { new => sub

    { my ($self) = shift; my $attributes = { @_ }; return bless $attributes, $self; }, } ); Rectangle->new( height => 10, Width => 20 );
  71. Metaclass->create_class( package => 'Rectangle', methods => { new => sub

    { my ($self) = shift; my $attributes = { @_ }; return bless $attributes, $self; }, } ); Rectangle->new( height => 10, Width => 20 );
  72. sub create_class { my ($self, %options) = @_; my $class

    = $options{ package }; $options{ methods }->{ meta } = \&get_meta; my $methods = $options{ methods }; while( my ($method, $body) = each( %$methods ) ) { no strict 'refs'; *{ "${class}::$method" } = $body; } # end while loop }
  73. my %meta_to_class; sub get_meta { my $class = shift; Metaclass->get_metaclass(

    $class ); }; sub get_metaclass { my $class = shift; return bless $meta_to_class{ $_[ 0 ] }, $class; }
  74. my %meta_to_class; sub get_meta { my $class = shift; Metaclass->get_metaclass(

    $class ); }; sub get_metaclass { my $class = shift; return bless $meta_to_class{ $_[ 0 ] }, $class; }
  75. my %meta_to_class; sub get_meta { my $class = shift; Metaclass->get_metaclass(

    $class ); }; sub get_metaclass { my $class = shift; return bless $meta_to_class{ $_[ 0 ] }, $class; }
  76. my %meta_to_class; sub get_meta { my $class = shift; Metaclass->get_metaclass(

    $class ); }; sub get_metaclass { my $class = shift; return bless $meta_to_class{ $_[ 0 ] }, $class; }
  77. my %meta_to_class; sub get_meta { my $class = shift; Metaclass->get_metaclass(

    $class ); }; sub get_metaclass { my $class = shift; return bless $meta_to_class{ $_[ 0 ] }, $class; }
  78. my %meta_to_class; sub get_meta { my $class = shift; Metaclass->get_metaclass(

    $class ); }; sub get_metaclass { my $class = shift; return bless $meta_to_class{ $_[ 0 ] }, $class; }
  79. my %meta_to_class; sub get_meta { my $class = shift; Metaclass->get_metaclass(

    $class ); }; sub get_metaclass { my $class = shift; return bless $meta_to_class{ $_[ 0 ] }, $class; }
  80. sub create_class { my ($self, %options) = @_; my $class

    = $options{ package }; $options{ methods }->{ meta } = \&get_meta; my $methods = $options{ methods }; no strict 'refs'; while( my ($method, $body) = each( %$methods ) ) { *{ "${class}::$method" } = $body; } # end while loop use strict; set_metaclass( $class, \%options ); }
  81. my %meta_to_class; sub get_meta { my $class = shift; Metaclass->get_metaclass(

    $class ); }; sub get_metaclass { my $class = shift; return bless $meta_to_class{ $_[ 0 ] }, $class; } sub set_metaclass { $meta_to_class{ $_[ 0 ] } = $_[ 1 ]; }
  82. my %meta_to_class; sub get_meta { my $class = shift; Metaclass->get_metaclass(

    $class ); }; sub get_metaclass { my $class = shift; return bless $meta_to_class{ $_[ 0 ] }, $class; } sub set_metaclass { $meta_to_class{ $_[ 0 ] } = $_[ 1 ]; }
  83. Introspection Metaclass->create_class( package => 'Rectangle', methods => { new =>

    sub { my ($self) = shift; my $attributes = { @_ }; return bless $attributes, $self; }, }, ); print Dumper( Rectangle->meta );
  84. bless({ 'package' => 'Rectangle', 'methods' => { 'meta' => sub

    { "DUMMY" }, 'new' => sub { "DUMMY" } } }, 'Metaclass' );
  85. bless({ 'package' => 'Rectangle', 'methods' => { 'meta' => sub

    { "DUMMY" }, 'new' => sub { "DUMMY" } } }, 'Metaclass' );
  86. Inheritance • Every package's symbol table has an array named

    ISA • @PackageName::ISA
  87. Inheritance if( $options{ superclasses } && @{$options{ superclasses }} )

    { @{"${class}::ISA"} = @{$options{ superclasses }} }
  88. Inheritance if( $options{ superclasses } && @{$options{ superclasses }} )

    { @{"${class}::ISA"} = @{$options{ superclasses }}; }
  89. Metaclass->create_class( package => 'ColoredRectangle', superclasses => [ 'Rectangle' ], );

  90. Metaclass->create_class( package => 'ColoredRectangle', superclasses => [ 'Rectangle' ], );

  91. And it works, I can do ColoredRectangle->new();

  92. But please don't try aforementioned things

  93. It's incomplete & may be fragile

  94. But why?

  95. “Manipulating stashes (Perl's symbol tables) is occasionally necessary, but incredibly

    messy, and easy to get wrong. This module hides all of that behind a simple API.” `man Package::Stash`
  96. But why? • use Package::Stash; • use Symbol::Table;

  97. But why? • Metaclass.pm is very basic • But actually

    Metaclasses are not so simple • Look at Moose
  98. Moose • Metaclasses for attributes • Metaclasses for methods

  99. Inheritance & metaclass compatibility • A has a method i-foo

    – Calls c-bar of MetaA • B inherits from A – B has i-foo • MetaB may not have c-bar
  100. Inheritance & metaclass compatibility package MetaA; .... sub c_bar {

    print "in c_bar\n"; } 1;
  101. Inheritance & metaclass compatibility MetaA->create_class( package => 'A', methods =>

    { new => sub { my ($self) = shift; my $attributes = { @_ }; return bless $attributes, $self; }, i_foo => sub { my ($self) = shift; my $meta = $self->meta; $meta->c_bar; }, }, ); A->i_foo();
  102. Inheritance & metaclass incompatibility MetaB->create_class( package => 'B', methods =>

    { new => sub { my ($self) = shift; my $attributes = { @_ }; return bless $attributes, $self; }, }, superclasses => [ 'A' ], ); B->i_foo;
  103. Inheritance & metaclass incompatibility Can't locate object method "c_bar" via

    package "MetaB" at test.pl line 24.
  104. Inheritance & metaclass incompatibility i_foo => sub { my ($self)

    = shift; my $meta = $self->meta; $meta->c_bar; },
  105. Inheritance & metaclass incompatibility package MetaB; .... # NO c_bar

    1;
  106. Inheritance & metaclass incompatibility • MetaA has a method c-foo

    • c-foo needs to call i- bar in A • MetaB inherits from MetaA • B has to has i-bar
  107. Inheritance & metaclass incompatibility package MetaA; ..... sub c_foo {

    my ( $self, $child ) = @_; $child->i_bar; } 1;
  108. Inheritance & metaclass incompatibility package MetaB; use strict; use warnings;

    use parent 'MetaA'; 1;
  109. Inheritance & metaclass incompatibility MetaA->create_class( package => 'A', methods =>

    { new => sub { my ($self) = shift; my $attributes = { @_ }; return bless $attributes, $self; }, i_bar => sub { print "in i_bar\n"; }, }, ); MetaA->c_foo( 'A' );
  110. Inheritance & metaclass incompatibility MetaB->create_class( package => 'B', methods =>

    { new => sub { my ($self) = shift; my $attributes = { @_ }; return bless $attributes, $self; }, # NO i_bar }, ); MetaB->c_foo( 'B' );
  111. Inheritance & metaclass incompatibility Can't locate object method "i_bar" via

    package "B" at MetaA.pm line 16.
  112. Inheritance & metaclass compatibility sub c_foo { my ( $self,

    $child ) = @_; $child->i_bar; }
  113. Metaclass Incompatibility • Various ways of dealing with this

  114. Metaclass compatibility (Moose) • Does parent & child metaclasses have

    any common ancestors? – If yes, then \o/ – else, die • Moose::Exception::CannotFixMetaclassComp atibility
  115. Mixins • A class that contains a combination of methods

    from other classes • 'Included' rather than 'inherited' • Moose roles are similar to mixins
  116. Rules of mixins-based inheritance • Order of the mixins matter

    • Mixins take precedence over non-mixins
  117. Mixins-based inheritance

  118. Mixins-based inheritance • B => {M1.M2.A}

  119. Rules of mixins-based inheritance • Methods in M2 will take

    precedence over A • Methods in M1 will take precedence over M2
  120. Mixins-based inheritance • C => { M3.B.M1.M2.A }

  121. Rules of mixins-based inheritance • Methods in B will take

    precedence over M1 • Methods in M3 will take precedence over B
  122. Moose provides a great MOP

  123. Creating a class Moose::Meta::Class->create( 'Rectangle', attributes => { 'height' =>

    { is => 'ro', isa => 'Int', }, ... }, );
  124. Introspection • For getting attributes: Rectangle->meta->get_attributes_list(); • For getting methods:

    Rectangle->meta->get_methods_list(); • For getting superclasses: Rectangle->meta->superclasses;
  125. Introspection • For getting attributes: Rectangle->meta->get_attributes_list(); • For getting methods:

    Rectangle->meta->get_methods_list(); • For getting superclasses: Rectangle->meta->superclasses;
  126. Introspection • For getting attributes: Rectangle->meta->get_attributes_list(); • For getting methods:

    Rectangle->meta->get_methods_list(); • For getting superclasses: Rectangle->meta->superclasses;
  127. Introspection • For getting attributes: Rectangle->meta->get_attributes_list(); • For getting methods:

    Rectangle->meta->get_methods_list(); • For getting superclasses: Rectangle->meta->superclasses;
  128. Changing Class definition • For adding a new attribute: Rectangle->meta->add_attribute(...);

    • For adding a new method: Rectangle->meta->add_method(...);
  129. Changing Class definition • For adding a new attribute: Rectangle->meta->add_attribute(...);

    • For adding a new method: Rectangle->meta->add_method(...);
  130. Changing Class definition • For adding a new attribute: Rectangle->meta->add_attribute(...);

    • For adding a new method: Rectangle->meta->add_method(...);
  131. Drawbacks of MOP • Makes things slow • While using

    Moose, don't forget to do: __PACKAGE__->meta->make_immutable; – It tells Moose that you are not going to change your class at runtime
  132. Bibliography • The Art of the Metaobject Protocol • Metaclass

    Composition Using Mixin-Based Inheritance by Noury Bouraqadi • Wikipedia • Moose documentation • And lots of other random resources on the internet • Stevan Little's awesome brain :)
  133. Thank you for your time

  134. Questions?

  135. • Slides: https://speakerdeck.com/upasana20/intro-to-mop-presented-a t-yapc-na • Code examples: https://github.com/Sweet-kid/Intro-to-MOP-YAPC