Introduction to Metaobject Protocol - Speaker Deck

Tweet

Tweet

Slide 1

Slide 1 text

Meta Object Protocol (MOP) Upasana [email protected]

Slide 2

Slide 2 text

Backstory ● GNOME Outreach Program for Women internship in 2013 ● Structured exceptions in Moose

Slide 3

Slide 3 text

Motivation behind this talk ● To share what I learnt during my internship ● Some problems can be solved in a better way

Slide 4

Slide 4 text

How a class looks like? ● Class name ● Superclasses

Slide 5

Slide 5 text

How a class looks like? ● Attributes – Is read only or read-write – Type (int, float etc.) – Default value if any – Getter – Setter

Slide 6

Slide 6 text

How a class looks like? ● Methods – method name – Body

Slide 7

Slide 7 text

Classes in Perl ● Perl doesn't provide any special syntax for classes ● Perl packages are classes

Slide 8

Slide 8 text

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

Slide 9

Slide 9 text

Object? ● A hash reference ● blessed into a class

Slide 10

Slide 10 text

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

Slide 11

Slide 11 text

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

Slide 12

Slide 12 text

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

Slide 13

Slide 13 text

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

Slide 14

Slide 14 text

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

Slide 15

Slide 15 text

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

Slide 16

Slide 16 text

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

Slide 17

Slide 17 text

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

Slide 18

Slide 18 text

What is Metaobject? ● Object which manipulates, creates, describes or implements other objects, including itself

Slide 19

Slide 19 text

What is a Metaclass? ● Class which manipulates, creates, describes or implements other classes

Slide 20

Slide 20 text

What is MOP? ● provides the vocabulary to access and manipulate the structure and behavior of objects.

Slide 21

Slide 21 text

Functions of MOP ● Creating and deleting new classes ● Changing the class structure ● Changing methods of the class

Slide 22

Slide 22 text

History of MOP ● First introduced in the Smalltalk ● Common LISP Object System (CLOS) was influenced by Smalltalk ● CLOS allowed multiple inheritance unlike Smalltalk

Slide 23

Slide 23 text

MOP in modern languages ● Javascript has Joose ● OpenC++ ● Java has Reflection API ● Perl has Moose

Slide 24

Slide 24 text

Why do we need a MOP?

Slide 25

Slide 25 text

Testing

Slide 26

Slide 26 text

Testing ● I work at booking.com ● Our website is moving very fast ● Many rollouts in a day

Slide 27

Slide 27 text

Testing ● We don't really have test suites ● People are reluctant to do rollouts ● Everything needs to be tested manually

Slide 28

Slide 28 text

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

Slide 29

Slide 29 text

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

Slide 30

Slide 30 text

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

Slide 31

Slide 31 text

Introspection ● Give me all the methods of Web::Handler. ● Run tests for all the methods.

Slide 32

Slide 32 text

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'); LWP::Simple::get($url); }

Slide 33

Slide 33 text

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'); LWP::Simple::get($url); }

Slide 34

Slide 34 text

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'); LWP::Simple::get($url); }

Slide 35

Slide 35 text

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'); LWP::Simple::get($url); }

Slide 36

Slide 36 text

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'); LWP::Simple::get($url); }

Slide 37

Slide 37 text

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'); LWP::Simple::get($url); }

Slide 38

Slide 38 text

Object Relational Mapping (ORM)

Slide 39

Slide 39 text

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 );

Slide 40

Slide 40 text

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 );

Slide 41

Slide 41 text

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 );

Slide 42

Slide 42 text

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 );

Slide 43

Slide 43 text

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

Slide 44

Slide 44 text

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

Slide 45

Slide 45 text

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

Slide 46

Slide 46 text

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

Slide 47

Slide 47 text

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

Slide 48

Slide 48 text

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

Slide 49

Slide 49 text

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

Slide 50

Slide 50 text

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

Slide 51

Slide 51 text

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

Slide 52

Slide 52 text

Implementing MOP in Perl

Slide 53

Slide 53 text

Creating a class at runtime ● Perl class is a package ● Every package has a symbol table

Slide 54

Slide 54 text

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

Slide 55

Slide 55 text

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

Slide 56

Slide 56 text

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;

Slide 57

Slide 57 text

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;

Slide 58

Slide 58 text

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;

Slide 59

Slide 59 text

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;

Slide 60

Slide 60 text

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;

Slide 61

Slide 61 text

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;

Slide 62

Slide 62 text

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;

Slide 63

Slide 63 text

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;

Slide 64

Slide 64 text

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

Slide 65

Slide 65 text

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

Slide 66

Slide 66 text

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

Slide 67

Slide 67 text

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

Slide 68

Slide 68 text

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

Slide 69

Slide 69 text

● There is not yet a way to get class of a class, i.e. metaclass

Slide 70

Slide 70 text

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 store_metaclass( $class, \%options ); }

Slide 71

Slide 71 text

sub get_meta { my $class = shift; Metaclass->get_metaclass( $class ); }; my %meta_to_class; sub get_metaclass { my ($self) = shift; return $meta_to_class{ $_[ 0 ] }; } sub store_metaclass { $meta_to_class{ $_[ 0 ] } = $_[ 1 ]; }

Slide 72

Slide 72 text

sub get_meta { my $class = shift; Metaclass->get_metaclass( $class ); }; my %meta_to_class; sub get_metaclass { my ($self) = shift; return $meta_to_class{ $_[ 0 ] }; } sub store_metaclass { $meta_to_class{ $_[ 0 ] } = $_[ 1 ]; }

Slide 73

Slide 73 text

sub get_meta { my $class = shift; Metaclass->get_metaclass( $class ); }; my %meta_to_class; sub get_metaclass { my ($self) = shift; return $meta_to_class{ $_[ 0 ] }; } sub store_metaclass { $meta_to_class{ $_[ 0 ] } = $_[ 1 ]; }

Slide 74

Slide 74 text

sub get_meta { my $class = shift; Metaclass->get_metaclass( $class ); }; my %meta_to_class; sub get_metaclass { my ($self) = shift; return $meta_to_class{ $_[ 0 ] }; } sub store_metaclass { $meta_to_class{ $_[ 0 ] } = $_[ 1 ]; }

Slide 75

Slide 75 text

sub get_meta { my $class = shift; Metaclass->get_metaclass( $class ); }; my %meta_to_class; sub get_metaclass { my ($self) = shift; return $meta_to_class{ $_[ 0 ] }; } sub store_metaclass { $meta_to_class{ $_[ 0 ] } = $_[ 1 ]; }

Slide 76

Slide 76 text

sub get_meta { my $class = shift; Metaclass->get_metaclass( $class ); }; my %meta_to_class; sub get_metaclass { my ($self) = shift; return $meta_to_class{ $_[ 0 ] }; } sub store_metaclass { $meta_to_class{ $_[ 0 ] } = $_[ 1 ]; }

Slide 77

Slide 77 text

sub get_meta { my $class = shift; Metaclass->get_metaclass( $class ); }; my %meta_to_class; sub get_metaclass { my ($self) = shift; return $meta_to_class{ $_[ 0 ] }; } sub store_metaclass { $meta_to_class{ $_[ 0 ] } = $_[ 1 ]; }

Slide 78

Slide 78 text

sub get_meta { my $class = shift; Metaclass->get_metaclass( $class ); }; my %meta_to_class; sub get_metaclass { my ($self) = shift; return $meta_to_class{ $_[ 0 ] }; } sub store_metaclass { $meta_to_class{ $_[ 0 ] } = $_[ 1 ]; }

Slide 79

Slide 79 text

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; store_metaclass( $class, \%options ); }

Slide 80

Slide 80 text

sub get_meta { my $class = shift; Metaclass->get_metaclass( $class ); }; my %meta_to_class; sub get_metaclass { my ($self) = shift; return $meta_to_class{ $_[ 0 ] }; } sub store_metaclass { $meta_to_class{ $_[ 0 ] } = $_[ 1 ]; }

Slide 81

Slide 81 text

sub get_meta { my $class = shift; Metaclass->get_metaclass( $class ); }; my %meta_to_class; sub get_metaclass { my ($self) = shift; return $meta_to_class{ $_[ 0 ] }; } sub store_metaclass { $meta_to_class{ $_[ 0 ] } = $_[ 1 ]; }

Slide 82

Slide 82 text

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

Slide 83

Slide 83 text

{ 'package' => 'Rectangle', 'methods' => { 'meta' => sub { "DUMMY" }, 'new' => sub { "DUMMY" } } };

Slide 84

Slide 84 text

{ 'package' => 'Rectangle', 'methods' => { 'meta' => sub { "DUMMY" }, 'new' => sub { "DUMMY" } } };

Slide 85

Slide 85 text

Inheritance ● Every package's symbol table has an array named ISA ● @PackageName::ISA

Slide 86

Slide 86 text

Inheritance @{"${class}::ISA"} = @$superclasses if( @{$options{ superclasses }} );

Slide 87

Slide 87 text

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

Slide 88

Slide 88 text

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

Slide 89

Slide 89 text

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

Slide 90

Slide 90 text

But please don't try aforementioned things

Slide 91

Slide 91 text

It's incomplete & may be fragile

Slide 92

Slide 92 text

But why?

Slide 93

Slide 93 text

“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`

Slide 94

Slide 94 text

But why? ● use Package::Stash; ● use Symbol::Table;

Slide 95

Slide 95 text

But why? ● Metaclass.pm is very basic ● But actually Metaclasses are not so simple ● Look at Moose

Slide 96

Slide 96 text

Moose ● Metaclasses for attributes ● Metaclasses for methods

Slide 97

Slide 97 text

Inheritance ● 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

Slide 98

Slide 98 text

Inheritance ● 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

Slide 99

Slide 99 text

Metaclass Incompatibility ● Various ways of dealing with this

Slide 100

Slide 100 text

Metaclass compatibility (Moose) ● Does parent & child metaclasses have any common ancestors? – If yes, then \o/ – else, die ● Moose::Exception::CannotFixMetaclassComp atibility

Slide 101

Slide 101 text

Mixins ● A class that contains a combination of methods from other classes ● 'Included' rather than 'inherited' ● Moose roles are similar to mixins

Slide 102

Slide 102 text

Rules of mixins-based inheritance ● Order of the mixins matter ● Mixins take precedence over non-mixins

Slide 103

Slide 103 text

Mixins-based inheritance

Slide 104

Slide 104 text

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

Slide 105

Slide 105 text

Rules of mixins-based inheritance ● Methods in M2 will take precedence over A ● Methods in M1 will take precedence over M2

Slide 106

Slide 106 text

Mixins-based inheritance ● C => { M3.B.M1.M2.A }

Slide 107

Slide 107 text

Rules of mixins-based inheritance ● Methods in B will take precedence over M1 ● Methods in M3 will take precedence over B

Slide 108

Slide 108 text

Moose provides a great MOP

Slide 109

Slide 109 text

Creating a class Moose::Meta::Class->create( 'Rectangle', attributes => { 'height' => { is => 'ro', isa => 'Int', }, ... }, );

Slide 110

Slide 110 text

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

Slide 111

Slide 111 text

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

Slide 112

Slide 112 text

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

Slide 113

Slide 113 text

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

Slide 114

Slide 114 text

Thank you for your time

Slide 115

Slide 115 text

Questions?