Upgrade to Pro — share decks privately, control downloads, hide ads and more …

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

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.

Steven Lembark

July 09, 2022
Tweet

More Decks by Steven Lembark

Other Decks in Technology

Transcript

  1. OOP is not an oxymoron. Conway’s Object Oriented Programming. Perl’s

    OO is flexible, adaptable. Allowed 20+ years of advances.
  2. OOP is not an oxymoron. Conway’s Object Oriented Programming. Perl’s

    OO is flexible, adaptable. Allowed 20+ years of advances. Largely through evolution.
  3. Example: NEXT NEXT::Foo SUPER with logic EVERY::foo EVERY::LAST::foo Destructor &

    Constructor chaining. Redispatch down and up the chain is automagical.
  4. EVERY::LAST Lazyness: Do something once. Perly ‘new’ is generic: sub

    new { my $proto = shift; my $obj = $proto->construct; $obj->EVERY::LAST::initialize( @_ ); $obj }
  5. 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 }
  6. EVERY Lazyness: Do something once. Neither do destructors. DESTROY {

    my $obj = shift; $obj->EVERY::cleanup; $obj }
  7. mro lacks EVERY & EVERY::LAST It does have “maybe_next”. Requires

    explicit daisy chain: sub initialize { my $obj = shift; ... $obj->mro::maybe_next }
  8. Fix one: mro::EVERY package Frobnicate; use mro::EVERY; sub new {

    my $frob = &construct; $frob->EVERY::LAST::initialize( @_ ); $frob } Looks like NEXT.
  9. Fix one: mro::EVERY Q: How to redispatch random subs? A:

    The magic of AUTOLOAD. PBP be damned...
  10. 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->@* ) ... }
  11. 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->@* ) ... }
  12. 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->@* ) ... }
  13. 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->@* ) ... }
  14. 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->@* ) ... }
  15. 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->@* ) ... }
  16. Finding a method Most common way to look: can(). for

    my $pkg ( $class->mro::get_linear_isa->@* ) { my $sub = $pkg->can( $name ) or next; ... }
  17. Finding a method Returns inherited $name, not declared. for my

    $pkg ( $class->mro::get_linear_isa->@* ) { my $sub = $pkg->can( $name ) or next; ... }
  18. 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; ... }
  19. 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; ... }
  20. 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( @_ ); }
  21. 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( @_ ); }
  22. 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; ... }
  23. 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.
  24. 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.
  25. 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
  26. 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);
  27. 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);
  28. Handling AUTOLOAD What if the package doesn’t define $name? Uses

    its own AUTOLOAD instead? # $name isn’t AUTOLOAD! *{ qualify_to_ref $name => $_ }{ CODE } // ()
  29. 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 { ... }
  30. 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 } }
  31. 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 } }
  32. 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 } }
  33. 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 } }
  34. map { *{ qualify_to_ref $name, $_ }{CODE} or do {

    local *{qualify_to_ref ISA => $_} = []; $_->can( $name ) ? $name : () } } $proto->mro::get_linear_isa->@*; Dispatching AUTOLOAD
  35. map { *{ qualify_to_ref $name, $_ }{CODE} or do {

    local *{qualify_to_ref ISA => $_} = []; $_->can( $name ) ? $name : () } } $proto->mro::get_linear_isa->@*; Dispatching AUTOLOAD
  36. map { *{ qualify_to_ref $name, $_ }{CODE} or do {

    local *{qualify_to_ref ISA => $_} = []; $_->can( $name ) ? $name : () } } $proto->mro::get_linear_isa->@*; Dispatching AUTOLOAD
  37. 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.
  38. Dispatching AUTOLOAD if( my $sub = $_->can( $name ) )

    { my $ref = qualify_to_ref AUTOLOAD => $_; sub { *$ref = \$name; goto &$sub; } ...
  39. Module is small Main package is just a pair of

    maps. Pseudo-classes are just a pair of AUTOLOADS.
  40. Fix two: Replace method lookup with mro. Replace “ref $x”

    with “blessed $x” for object tests. Replace “no strict” with qualify_to_ref...
  41. 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.
  42. 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; }
  43. DFS in Pure Perl Using mro sub NEXT::ELSEWHERE::ancestors { my

    $proto = shift; @{ $proto->mro::get_linear_isa( ‘dfs’ ) } }
  44. DFS in Pure Perl Using object syntax sub NEXT::ELSEWHERE::ancestors {

    my $proto = shift; $proto->mro::get_linear_isa( ‘dfs’ )->@* }
  45. 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; }
  46. 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.
  47. 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.
  48. Fix for backwards uses use NEXT qw( :backwards ); dfs

    in NEXT, c3 in EVERY. Without it we use class specification in both.
  49. Fix for backwards uses my %backwards = (); sub import

    { my $caller = caller; for( @_ ) { if( m{ :backwards } ) { $backwards{ $caller } = undef; } } }
  50. 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->@* }
  51. So what? It isn’t written in 5.8.8 Core modules have

    to be consistent. Doesn’t mean they can’t evolve.
  52. 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.
  53. 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
  54. 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.