Corinna-MOP.pl

#!perl

use v5.38;
use experimental 'class';

use Data::Dumper;
use MOP;

class Baz {
    method bling { 'BLING' }
}

class Bar 0.01 {}

class Foo :isa(Bar) {
    method bar { 'BAR' }
    method baz;
}

{
    # create a Meta Object
    my $f = MOP::Class->new('Foo');

    # alias a method to the class
    $f->add_method('blork' => sub {
        # while $self is not valid here
        # the invocant can be extracted
        # from @_ anyway :)
        join ', ' => $_[0]->gorch, 'BLORK'
    });

    # alias a method to the class
    $f->alias_method('gorch' => sub {
        # while $self is not valid here
        # the invocant can be extracted
        # from @_ anyway :)
        join ', ' => $_[0]->bar, 'GORCH'
    });

    # create another Meta Object
    my $b = MOP::Class->new('Bar');
    # and alter it's superclass
    $b->set_superclasses('Baz');

    # NOTE:
    # I tried doing multiple inheritence with:
    #   `$f->set_superclasses('Baz');`
    # and got this error from the call to `->new` below:
    #   `Cannot invoke a method of "Bar" on an instance of "Foo"`
    # I have no idea what was going on there :)
}

# and here is just proof that the above works ...
my $foo = Foo->new;
warn $foo->gorch;
warn $foo->blork;
warn $foo->bling;

# now dump the basic Class meta objects
# we can handle a subset of the current
# API, see notes embedded below

foreach my $m (map { MOP::Class->new($_) } qw[ Baz Bar Foo ]) {
    warn "============================\n";
    warn "Name         : ".$m->name."\n";
    warn "Version      : ".($m->version // 'NULL')."\n";
    # MOP has an `authority` method, but its not relevant
    warn "Superclasses : (".(join ', ' => $m->superclasses),")\n";
    warn "MRO          : (".(join ', ' => $m->mro->@*),")\n";
    warn "----------------------------\n";

    ## --------------------------------
    ## Methods
    ## --------------------------------
    # loop through all the methods in the class
    warn((join "\n" => map {
            "  Name     : ".$_->name,                  # the name, or __ANON__
            "  Body     : ".$_->body,                  # the CODE ref
            "  Required : ".($_->is_required ? 1 : 0), # method w/out body
            "  Stash    : ".$_->origin_stash,          # class it was compiled in
            # looking for the aliased method we made above
            "  Aliased  : ".$_->was_aliased_from('main'),
            # the MOP::Method has other methods
            # related to code attributes, they'll
            # likely still work once they work
            # in classes
            "----------------------------",
        } $m->all_methods), "\n");

    ## --------------------------------
    ## Fields - (aka) slots in the MOP
    ## --------------------------------
    # These could easily be supported with a bit of XS
    # (based on what I see in `perlclassguts`) and the
    # MOP::Slot API would mostly work, the biggest issue
    # I see is that MOP::Slot assumes the default value
    # is a CODE reference, and the `perlclassguts` says
    # that the default value is an optree. That said, I
    # imagine that it would be fairly easy to wrap the
    # optree into a CV and then a CODE ref for this.

    ## --------------------------------
    ## ADJUST blocks
    ## --------------------------------
    # Based on what I see in `perlclassguts` it would
    # be easy to support these. It says they are CVs
    # which could easily be turned into CODE refs, and
    # vice-versa for setting them as well

    ## --------------------------------
    ## Roles
    ## --------------------------------
    # these aren't supported yet, so they are not
    # relevant to this particular experiment
}

__END__

https://metacpan.org/pod/MOP

output.txt

BAR, GORCH at Corinna-MOP.pl line 55.
BAR, GORCH, BLORK at Corinna-MOP.pl line 56.
BLING at Corinna-MOP.pl line 57.
============================
Name         : Baz
Version      : NULL
Superclasses : ()
MRO          : (Baz)
----------------------------
  Name     : new
  Body     : CODE(0x1490339e8)
  Required : 0
  Stash    : Baz
  Aliased  : 0
----------------------------
  Name     : bling
  Body     : CODE(0x14918f3d0)
  Required : 0
  Stash    : Baz
  Aliased  : 0
----------------------------
============================
Name         : Bar
Version      : 0.01
Superclasses : (Baz)
MRO          : (Bar, Baz)
----------------------------
  Name     : new
  Body     : CODE(0x14918f610)
  Required : 0
  Stash    : Bar
  Aliased  : 0
----------------------------
============================
Name         : Foo
Version      : NULL
Superclasses : (Bar)
MRO          : (Foo, Bar, Baz)
----------------------------
  Name     : __ANON__
  Body     : CODE(0x14935efc8)
  Required : 0
  Stash    : main
  Aliased  : 1
----------------------------
  Name     : baz
  Body     : CODE(0x14935f1c0)
  Required : 1
  Stash    : Foo
  Aliased  : 0
----------------------------
  Name     : new
  Body     : CODE(0x14918f700)
  Required : 0
  Stash    : Foo
  Aliased  : 0
----------------------------
  Name     : bar
  Body     : CODE(0x14935ef50)
  Required : 0
  Stash    : Foo
  Aliased  : 0
----------------------------
  Name     : blork
  Body     : CODE(0x14935f1f0)
  Required : 0
  Stash    : Foo
  Aliased  : 0
----------------------------