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?