use strict;
use warnings;
package ClassUMS;

our $VERSION = '1.234';

my %STATIC = (
  new => sub {
    my ($pkg, $arg) = @_;
    my $class = bless $arg => $pkg;
  },
);

my %UNIVERSAL = (
  new  => sub { bless { __class__ => $_[0] } => $_[0]->instance_class, },
  name => sub { $_[0]->{name} },
  base => sub { $_[0]->{base} },
  new_subclass     => sub {
    my ($class, $arg) = @_;
    my $pkg = ref $class;
    my $new = { %$arg, base => $class };
    bless $new => $pkg;
  },
  instance_class   => sub { 'Instance' },
  class_methods    => sub { $_[0]->{class_methods} },
  instance_methods => sub { $_[0]->{instance_methods} },
  derives_from     => sub {
    my ($self, $super) = @_;

    # Nothing wrong with this! -- rjbs, 2009-03-21
    return unless (ref $self)->UNIVERSAL::isa(__PACKAGE__);

    my $curr = $self;
    while ($curr) {
      return 1 if $curr == $super;
      $curr = $curr->base;
    }
    return;
  },
);

use MRO::Magic sub {
  my ($invocant, $method_name, $args) = @_;
  my $curr = $invocant;
  my $code;

  unless (ref $invocant) {
    die "no metaclass method $method_name on $invocant"
      unless $code = $STATIC{$method_name};

    return $code->($invocant, @$args);
  }

  while ($curr) {
    my $methods = $curr->{class_methods};
    $code = $methods->{$method_name}, last
      if exists $methods->{$method_name};
    $curr = $curr->{base};
  }

  Carp::confess("no class method $method_name on $invocant->{name}")
    unless $code ||= $UNIVERSAL{$method_name};

  $code->($invocant, @$args);
};

1;