Introduction to Metaobject Protocol

Transcript

1. Meta Object Protocol (MOP) Upasana me@upasana.me
2. Backstory • GNOME Outreach Program for Women internship in 2013 • Structured exceptions in Moose
3. Motivation behind this talk • To share what I learnt during my internship • Some problems can be solved in a better way
4. How a class looks like? • Class name • Superclasses
5. How a class looks like? • Attributes – Is read only or read-write – Type (int, float etc.) – Default value if any – Getter – Setter
6. How a class looks like? • Methods – method name – Body
7. Classes in Perl • Perl doesn't provide any special syntax for classes • Perl packages are classes
8. 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
9. Object? • A hash reference • blessed into a class
10. OOP in Perl package Rectangle; sub new { my $self = shift; my $attributes = {@_}; bless $attributes, $self; } 1; Rectangle->new( height => 10, width => 20, );
11. OOP in Perl package Rectangle; sub new { my $self = shift; my $attributes = {@_}; bless $attributes, $self; } 1; Rectangle->new( height => 10, width => 20, );
12. OOP in Perl package Rectangle; sub new { my $self = shift; my $attributes = {@_}; bless $attributes, $self; } 1; Rectangle->new( height => 10, width => 20, );
13. OOP in Perl package Rectangle; sub new { my $self = shift; my $attributes = {@_}; bless $attributes, $self; } 1; Rectangle->new( height => 10, width => 20, );
14. OOP in Perl package Rectangle; sub new { my $self = shift; my $attributes = {@_}; bless $attributes, $self; } 1; Rectangle->new( height => 10, width => 20, );
15. OOP in Perl package Rectangle; sub new { my $self = shift; my $attributes = {@_}; bless $attributes, $self; } 1; Rectangle->new( height => 10, width => 20, );
16. OOP in Perl package Rectangle; sub new { my $self = shift; my $attributes = {@_}; bless $attributes, $self; } 1; Rectangle->new( height => 10, width => 20, );
17. OOP in Perl package Rectangle; sub new { my $self = shift; my $attributes = {@_}; bless $attributes, $self; } 1; Rectangle->new( height => 10, width => 20, );
18. What is Metaobject? • Object which manipulates, creates, describes or implements other objects, including itself
19. What is a Metaclass? • Class which manipulates, creates, describes or implements other classes
20. What is MOP? • provides the vocabulary to access and manipulate the structure and behavior of objects.
21. Functions of MOP • Creating and deleting new classes • Changing the class structure • Changing methods of the class
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 really have test suites • People are reluctant to do rollouts • Everything needs 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. Introspection • Give me all the methods of Web::Handler. • Run tests for all the methods.
32. 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); }
33. 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); }
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'); 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'); 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'); 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'); LWP::Simple::get($url); }
38. Object Relational Mapping (ORM)
39. 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 );
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 $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, ); ); }
44. 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, ); ); }
45. 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, ); ); }
46. 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, ); ); }
47. 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, ); ); }
48. 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, ); ); }
49. 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, ); ); }
50. 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, ); ); }
51. 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, ); ); }
52. Implementing MOP in Perl
53. Creating a class at runtime • Perl class is a package • Every package has a symbol table
54. Symbol table • Hash of subroutines/variables defined in a package • package name with two colons appended $Rectangle::
55. Symbol table • Hash of subroutines/variables defined in a package • package name with two colons appended $Rectangle::
56. 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;
57. 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;
58. 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;
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. Metaclass->create_class( package => 'Rectangle', methods => { new => sub { my ($self) = shift; my $attributes = {@_}; return bless $attributes, $self; }, } ); Rectangle->new( height => 10, Width => 20 );
65. Metaclass->create_class( package => 'Rectangle', methods => { new => sub { my ($self) = shift; my $attributes = {@_}; return bless $attributes, $self; }, } ); Rectangle->new( height => 10, Width => 20 );
66. Metaclass->create_class( package => 'Rectangle', methods => { new => sub { my ($self) = shift; my $attributes = {@_}; return bless $attributes, $self; }, } ); Rectangle->new( height => 10, Width => 20 );
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. • There is not yet a way to get class of a class, i.e. metaclass
70. 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 ); }
71. 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 ]; }
72. 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 ]; }
73. 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 ]; }
74. 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 ]; }
75. 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 ]; }
76. 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 ]; }
77. 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 ]; }
78. 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 ]; }
79. 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 ); }
80. 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 ]; }
81. 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 ]; }
82. Introspection Metaclass->create_class( package => 'Rectangle', methods => { new => sub { my ($self) = shift; my $attributes = {@_}; return bless $attributes, $self; }, }, ); print Dumper( Rectangle->meta );
83. { 'package' => 'Rectangle', 'methods' => { 'meta' => sub { "DUMMY" }, 'new' => sub { "DUMMY" } } };
84. { 'package' => 'Rectangle', 'methods' => { 'meta' => sub { "DUMMY" }, 'new' => sub { "DUMMY" } } };
85. Inheritance • Every package's symbol table has an array named ISA • @PackageName::ISA
86. Inheritance @{"${class}::ISA"} = @$superclasses if( @{$options{ superclasses }} );
87. Metaclass->create_class( package => 'ColoredRectangle', superclasses => [ 'Rectangle' ], );
88. Metaclass->create_class( package => 'ColoredRectangle', superclasses => [ 'Rectangle' ], );
89. And it works, I can do ColoredRectangle->new();
90. But please don't try aforementioned things
91. It's incomplete & may be fragile
92. But why?
93. “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`
94. But why? • use Package::Stash; • use Symbol::Table;
95. But why? • Metaclass.pm is very basic • But actually Metaclasses are not so simple • Look at Moose
96. Moose • Metaclasses for attributes • Metaclasses for methods
97. 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
98. 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
99. Metaclass Incompatibility • Various ways of dealing with this
100. Metaclass compatibility (Moose) • Does parent & child metaclasses have any common ancestors? – If yes, then \o/ – else, die • Moose::Exception::CannotFixMetaclassComp atibility
101. Mixins • A class that contains a combination of methods from other classes • 'Included' rather than 'inherited' • Moose roles are similar to mixins
102. Rules of mixins-based inheritance • Order of the mixins matter • Mixins take precedence over non-mixins
103. Mixins-based inheritance
104. Mixins-based inheritance • B => {M1.M2.A}
105. Rules of mixins-based inheritance • Methods in M2 will take precedence over A • Methods in M1 will take precedence over M2
106. Mixins-based inheritance • C => { M3.B.M1.M2.A }
107. Rules of mixins-based inheritance • Methods in B will take precedence over M1 • Methods in M3 will take precedence over B
108. Moose provides a great MOP
109. Creating a class Moose::Meta::Class->create( 'Rectangle', attributes => { 'height' => { is => 'ro', isa => 'Int', }, ... }, );
110. Introspection • For getting attributes: Rectangle->meta->get_attributes_list(); • For getting methods: Rectangle->meta->get_methods_list(); • For getting superclasses: Rectangle->meta->superclasses;
111. Changing Class definition • For adding a new attribute: Rectangle->meta->add_attribute(...); • For adding a new method: Rectangle->meta->add_method(...);
112. 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
113. 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
114. Thank you for your time
115. Questions?