Evolution of OOP: mro for EVERY::LAST one of us!

The evolution of Object-Oriented Perl has gone through a number of stages. An early advance was NEXT, which gave optional re-dispatch and the pseudo-classes EVERY & EVERY::LAST to dispatch up and down the stack automatically. Then mro() came along and offered improved method dispatch, but left out the pseudo-classes. This talk describes adding a role to mro::EVERY to add the pseudo-classes and also how to hack mro() into NEXT in a backwards compatible way.

Transcript

1. Evolution of OOP: mro for EVERY::LAST one of us! Steven Lembark Workhorse Computing lembark@wrkhors.com
2. OOP is not an oxymoron. Conway’s Object Oriented Programming. Perl’s OO is flexible, adaptable. Allowed 20+ years of advances.
3. OOP is not an oxymoron. Conway’s Object Oriented Programming. Perl’s OO is flexible, adaptable. Allowed 20+ years of advances. Largely through evolution.
4. Example: NEXT NEXT::Foo SUPER with logic EVERY::foo EVERY::LAST::foo Destructor & Constructor chaining. Redispatch down and up the chain is automagical.
5. EVERY::LAST Lazyness: Do something once. Perly ‘new’ is generic: sub new { my $proto = shift; my $obj = $proto->construct; $obj->EVERY::LAST::initialize( @_ ); $obj }
6. EVERY::LAST Lazyness: Do something once. Initializers don’t have to daisy-chain. sub new { my $proto = shift; my $obj = $proto->construct; $obj->EVERY::LAST::initialize( @_ ); $obj }
7. EVERY Lazyness: Do something once. Neither do destructors. DESTROY { my $obj = shift; $obj->EVERY::cleanup; $obj }
8. Evolution: mro Offers “c3” instead of depth-first search. Saner, more predictable. Whole lot faster than NEXT.
9. mro lacks EVERY & EVERY::LAST It does have “maybe_next”. Requires explicit daisy chain: sub initialize { my $obj = shift; ... $obj->mro::maybe_next }
10. Fix: Hubris
11. Fix: mro::EVERY Installs two pseudo-classes: EVERY EVERY::LAST Dispatch down/up the inheritence tree. Order defined by mro.
12. Fix one: mro::EVERY package Frobnicate; use mro::EVERY; sub new { my $frob = &construct; $frob->EVERY::LAST::initialize( @_ ); $frob } Looks like NEXT.
13. Fix one: mro::EVERY Q: How to redispatch random subs?
14. Fix one: mro::EVERY Q: How to redispatch random subs? A: The magic of AUTOLOAD.
15. Fix one: mro::EVERY Q: How to redispatch random subs? A: The magic of AUTOLOAD. PBP be damned...
16. Start with mro mro::get_linear_isa Resolves package “isa”. Uses depth-first or “c3”.
17. AUTOLOAD does the dispatch $foo->EVERY::bar( @blort ); package EVERY; our $AUTOLOAD = ‘’; sub AUTOLOAD { my ( $name ) = $AUTOLOAD =~ m{ (\w+) $}x; my $proto = shift; for my $pkg ( $proto->mro::get_linear_isa->@* ) ... }
18. AUTOLOAD does the dispatch $foo->EVERY::bar( @blort ); package EVERY; our $AUTOLOAD = ‘’; sub AUTOLOAD { my ( $name ) = $AUTOLOAD = m{ (\w+) $}x; my $proto = shift; for my $pkg ( $proto->mro::get_linear_isa->@* ) ... }
19. AUTOLOAD does the dispatch $foo->EVERY::bar( @blort ); package EVERY; our $AUTOLOAD = ‘EVERY::bar’; sub AUTOLOAD { my ( $name ) = $AUTOLOAD = m{ (\w+) $}x; my $proto = shift; for my $pkg ( $proto->mro::get_linear_isa->@* ) ... }
20. AUTOLOAD does the dispatch $foo->EVERY::bar( @blort ); package EVERY; our $AUTOLOAD = ‘’; sub AUTOLOAD { my ( $name ) = $AUTOLOAD = m{ (\w+) $}x; my $proto = shift; for my $pkg ( $proto->mro::get_linear_isa->@* ) ... }
21. AUTOLOAD does the dispatch $foo->EVERY::bar( @blort ); package EVERY; our $AUTOLOAD = ‘’; sub AUTOLOAD { my ( $name ) = $AUTOLOAD = m{ (\w+) $}x; my $proto = shift; for my $pkg ( $proto->mro::get_linear_isa->@* ) ... }
22. AUTOLOAD does the dispatch $foo->EVERY::bar( @blort ); package EVERY; our $AUTOLOAD = ‘’; sub AUTOLOAD { my ( $name ) = $AUTOLOAD = m{ (\w+) $}x; my $proto = shift; for my $pkg ( $proto->mro::get_linear_isa->@* ) ... }
23. Finding a method Most common way to look: can(). for my $pkg ( $class->mro::get_linear_isa->@* ) { my $sub = $pkg->can( $name ) or next; ... }
24. Finding a method Returns inherited $name, not declared. for my $pkg ( $class->mro::get_linear_isa->@* ) { my $sub = $pkg->can( $name ) or next; ... }
25. Finding a method Symbol::qualify_to_ref. for my $pkg ( $class->mro::get_linear_isa->@* ) { my $sub = *{ qualify_to_ref $name => $pkg }{ CODE } or next; ... }
26. Finding a method Subref when it’s defined in the package. for my $pkg ( $class->mro::get_linear_isa->@* ) { my $sub = *{ qualify_to_ref $name => $pkg }{ CODE } or next; ... }
27. Redispatching a method. Perl has first-class subs. for my $pkg ( $class->mro::get_linear_isa->@* ) { my $sub = *{ qualify_to_ref $name => $pkg }{ CODE } or next; $proto->$sub( @_ ); }
28. Redispatching a method. Doesn’t handle AUTOLOAD! for my $pkg ( $class->mro::get_linear_isa->@* ) { my $sub = *{ qualify_to_ref $name => $pkg }{ CODE } or next; $proto->$sub( @_ ); }
29. EVERY::LAST dispatchs up the tree Not much difference: for my $pkg ( reverse $class->mro::get_linear_isa->@* ) { my $sub = *{ qualify_to_ref $name => $pkg }{ CODE } or next; ... } for my $pkg ( reverse $class->mro::get_linear_isa->@* ) { my $sub = *{ qualify_to_ref $name => $pkg }{ CODE } or next; ... }
30. Avoiding “Red Flags” Cut+Paste is a mistake.
31. Avoiding “Red Flags” my $methodology = sub { my ( $proto, $name ) = @_; map { *{ qualify_to_ref $name => $_ }{ CODE } // () } $proto->mro::get_linear_isa->@* }; Package the re-usable portion in a utility sub.
32. Avoiding “Red Flags” package EVERY; our $AUTOLOAD = ‘’; sub AUTOLOAD { my $proto = shift; my $name = ( split ‘::’, $AUTOLOAD )[-1]; $proto->$_( @_ ) for uniq $methodology->($proto, $name) } List of subs in mro-order.
33. Avoiding “Red Flags” package EVERY::LAST; our $AUTOLOAD = ‘’; sub AUTOLOAD { my $proto = shift; my $name = ( split ‘::’, $AUTOLOAD )[-1]; $proto->$_( @_ ) for uniq reverse $methodology->($proto, $name) } Reverse the order for Every::Last
34. Avoiding “Red Flags” for uniq $methodology->($proto, $name); for uniq reverse $methodology->($proto, $name);
35. Avoiding “Red Flags” Avoid re-dispatching identical methods. use Foo qw( bar ); Only want to dispatch it once. for uniq $methodology->($proto, $name); for uniq reverse $methodology->($proto, $name);
36. Avoiding “Red Flags” EVERY uses most-derived. First defined method looking down the tree. Useful for destructors peeling off layers. EVERY::LAST uses least-derived. Constructor-ish code handled by base classes. for uniq $methodology->($proto, $name); for uniq reverse $methodology->($proto, $name);
37. Handling AUTOLOAD What if the package doesn’t define $name? Uses its own AUTOLOAD instead? # $name isn’t AUTOLOAD! *{ qualify_to_ref $name => $_ }{ CODE } // ()
38. Handling AUTOLOAD Requires an co-operating ‘can’ operator. More expsive: you have to ask for it. use mro::EVERY qw( autoload ); *{ qualify_to_ref $name => $_ }{ CODE } or do { ... }
39. Doing the can can() package Yours; our $AUTOLOAD = ‘’; sub AUTOLOAD { … } my @names = qw( this that other ); my %auto_can = map { ( $_ => \&AUTOLOAD ) } @names; sub can { my ( $proto, $name ) = @_; $proto->can( $name ) or $auto_can{ $name } }
40. Doing the can can() package Yours; our $AUTOLOAD = ‘’; sub AUTOLOAD { … } my @names = qw( this that other ); my %auto_can = map { ( $_ => \&AUTOLOAD ) } @names; sub can { my ( $proto, $name ) = @_; $proto->can( $name ) or $auto_can{ $name } }
41. Doing the can can() package Yours; our $AUTOLOAD = ‘’; sub AUTOLOAD { … } my @names = qw( this that other ); my %auto_can = map { ( $_ => \&AUTOLOAD ) } @names; sub can { my ( $proto, $name ) = @_; $proto->can( $name ) or $auto_can{ $name } }
42. Doing the can can() package Yours; our $AUTOLOAD = ‘’; sub AUTOLOAD { … } my @names = qw( this that other ); my %auto_can = map { ( $_ => \&AUTOLOAD ) } @names; sub can { my ( $proto, $name ) = @_; $proto->can( $name ) or $auto_can{ $name } }
43. map { *{ qualify_to_ref $name, $_ }{CODE} or do { local *{qualify_to_ref ISA => $_} = []; $_->can( $name ) ? $name : () } } $proto->mro::get_linear_isa->@*; Dispatching AUTOLOAD
44. map { *{ qualify_to_ref $name, $_ }{CODE} or do { local *{qualify_to_ref ISA => $_} = []; $_->can( $name ) ? $name : () } } $proto->mro::get_linear_isa->@*; Dispatching AUTOLOAD
45. map { *{ qualify_to_ref $name, $_ }{CODE} or do { local *{qualify_to_ref ISA => $_} = []; $_->can( $name ) ? $name : () } } $proto->mro::get_linear_isa->@*; Dispatching AUTOLOAD
46. Dispatching AUTOLOAD Yes, $name isn’t qualified. Required for Perl to set $AUTOLOAD. Point of AUTOLOAD is a catch-all. Stacked AUTOLOAD calls are rare.
47. Dispatching AUTOLOAD Alternative: dispatch with a closure. Pre-load $AUTOLOAD with qualify_to_ref. Dispatch via subref.
48. Dispatching AUTOLOAD if( my $sub = $_->can( $name ) ) { my $ref = qualify_to_ref AUTOLOAD => $_; sub { *$ref = \$name; goto &$sub; } ...
49. Module is small Main package is just a pair of maps. Pseudo-classes are just a pair of AUTOLOADS.
50. Fix two: Lots of Hubris...
51. Fix two: Hack NEXT.
52. Fix two: Replace method lookup with mro. Replace “ref $x” with “blessed $x” for object tests. Replace “no strict” with qualify_to_ref...
53. Into the nextaverse Two subs do the dirty work: NEXT::ELSEWHERE::ancestors NEXT::ELSEWHERE::ordered_ancestors
54. Into the nextaverse Two subs do the dirty work: NEXT::ELSEWHERE::ancestors Depth-first-search in Pure Perl. NEXT::ELSEWHERE::ordered_ancestors c3[ish] in Pure Perl.
55. DFS in Pure Perl Iterate @ISA chains with symbolic refs. sub NEXT::ELSEWHERE::ancestors { my @inlist = shift; my @outlist = (); while (my $next = shift @inlist) { push @outlist, $next; no strict 'refs'; unshift @inlist, @{"$outlist[-1]::ISA"}; } return @outlist; }
56. DFS in Pure Perl Using mro sub NEXT::ELSEWHERE::ancestors { my $proto = shift; @{ $proto->mro::get_linear_isa( ‘dfs’ ) } }
57. DFS in Pure Perl Using object syntax sub NEXT::ELSEWHERE::ancestors { my $proto = shift; $proto->mro::get_linear_isa( ‘dfs’ )->@* }
58. Purly Perly c3[ish] sub NEXT::ELSEWHERE::ordered_ancestors { my @inlist = shift; my @outlist = (); while (my $next = shift @inlist) { push @outlist, $next; no strict 'refs'; push @inlist, @{"$outlist[-1]::ISA"}; } return sort { $a->isa($b) ? -1 : $b->isa($a) ? +1 : 0 } @outlist; }
59. Purly Perly c3[ish] sub NEXT::ELSEWHERE::ordered_ancestors { my $proto = shift; $proto->mro::get_linear_isa->( ‘c3’ )->@* }
60. Purly Perly c3[ish] sub NEXT::ELSEWHERE::ordered_ancestors { my $proto = shift; $proto->mro::get_linear_isa->( ‘c3’ )->@* } Well, Almost: OA sorts depth-first, then left-most. C3 sorts left-most, then depth-first. Both constrain derived classes to precede base classes.
61. EVERY vs. EVERY::LAST NEXT uses ancestors(). EVERY & EVERY::LAST use ordered_ancestors(). NEXT => mro( ‘dfs’ ) EVERY => mro( ‘c3’ ) Ideally both use mro from classes.
62. Fix for backwards uses use NEXT qw( :backwards ); dfs in NEXT, c3 in EVERY. Without it we use class specification in both.
63. Fix for backwards uses my %backwards = (); sub import { my $caller = caller; for( @_ ) { if( m{ :backwards } ) { $backwards{ $caller } = undef; } } }
64. Fix for backwards uses sub NEXT::ELSEWHERE::ancestors { my $proto = shift; exists $backwards{ blessed $proto } ? $proto->mro::get_linear_isa->( 'dfs' )->@* : $proto->mro::get_linear_isa->@* }
65. So what? It isn’t written in 5.8.8 Core modules have to be consistent. Doesn’t mean they can’t evolve.
66. So what? It isn’t written in 5.8.8 Provide people what they want: 5.8 users get a 5.8 module. Later users get a later module. Bugs can be fixed everywhere. Features get added to the more recent versions.
67. So what? It isn’t written in 5.8.8 Handled in Makfile.PL: Install first directory <= $^V with File::Copy::Recursive. Added to FindBin:libs in 5.14. NEXT-x.y.z Makefile.PL version v5.8.8 lib NEXT.pm t ... v5.10 lib NEXT.pm # mro t ... v5.24 lib NEXT.pm # ->@* t
68. Yes, there is more than one way Layering EVERY onto mro isn’t difficult. Inserting mro() into NEXT isn’t that hard either. Advancing modules with Perl is doable.
69. References https://metacpan.org/pod/NEXT https://metacpan.org/pod/mro::EVERY Handling multiple versions: https://metacpan.org/release/LEMBARK/FindBin-libs- v3.0.1/source/Makefile.PL#L63 https://metacpan.org/pod/Module::FromPerlVer