Merge mo-cleanup -r520..524.

lib/Lmo.pm

@@ -0,0 +1,363 @@
+# This program is copyright 2007-2011 Baron Schwartz, 2012 Percona Inc.
+# Feedback and improvements are welcome.
+#
+# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+#
+# This program is free software; you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free Software
+# Foundation, version 2; OR the Perl Artistic License.  On UNIX and similar
+# systems, you can issue `man perlgpl' or `man perlartistic' to read these
+# licenses.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
+# Place, Suite 330, Boston, MA  02111-1307  USA.
+# ###########################################################################
+# Lmo package
+# ###########################################################################
+# Package: Lmo
+# Lmo provides a miniature object system in the style of Moose and Moo.
+BEGIN {
+$INC{"Lmo.pm"} = __FILE__;
+package Lmo;
+our $VERSION = '0.30_Percona'; # Forked from 0.30 of Mo.
+
+{
+   # Gets the glob from a given string.
+   no strict 'refs';
+   sub _glob_for {
+      return \*{shift()}
+   }
+
+   # Gets the stash from a given string.
+   # A stash is a symbol table hash; rough explanation on
+   # http://perldoc.perl.org/perlguts.html#Stashes-and-Globs
+   # But the gist of it is that we can use a hash-like thing to
+   # refer to a class and modify it.
+   sub _stash_for {
+      return \%{ shift() . "::" };
+   }
+}
+
+use strict;
+use warnings qw( FATAL all );
+
+use Carp ();
+use Scalar::Util qw(looks_like_number blessed);
+
+use Lmo::Meta;
+use Lmo::Object;
+use Lmo::Types;
+
+my %export_for;
+sub import {
+    # Set warnings and strict for the caller.
+    warnings->import(qw(FATAL all));
+    strict->import();
+    
+    my $caller     = scalar caller(); # Caller's package
+    my $caller_pkg = $caller . "::"; # Caller's package with :: at the end
+    my %exports = (
+        extends => \&extends,
+        has     => \&has,
+    );
+
+    # We keep this so code doing 'no Mo;' actually does a cleanup.
+    $export_for{$caller} = [ keys %exports ];
+
+    # Export has, extends and sosuch.
+    for my $keyword ( keys %exports ) {
+      *{ _glob_for "${caller}::$keyword" } = $exports{$keyword}
+    }
+
+    # Set up our caller's ISA, unless they already set it manually themselves,
+    # in which case we assume they know what they are doing.
+    # XXX weird syntax here because we want to call the classes' extends at
+    # least once, to avoid warnings.
+    if ( !@{ *{ _glob_for "${caller}::ISA" }{ARRAY} || [] } ) {
+      @_ = "Lmo::Object";
+      goto *{ _glob_for "${caller}::extends" }{CODE};
+    }
+};
+
+sub extends {
+   my $caller = scalar caller();
+   for my $class ( @_ ) {
+      _load_module($class);
+   }
+   _set_package_isa($caller, @_);
+   _set_inherited_metadata($caller);
+}
+
+sub _load_module {
+   my ($class) = @_;
+   
+   # Try loading the class, but don't croak if we fail.
+   (my $file = $class) =~ s{::|'}{/}g;
+   $file .= '.pm';
+   { local $@; eval { require "$file" } } # or warn $@;
+   return;
+}
+
+sub has {
+   my $names  = shift;
+   my $caller = scalar caller();
+
+   my $class_metadata = Lmo::Meta->metadata_for($caller);
+   
+   for my $attribute ( ref $names ? @$names : $names ) {
+      my %args   = @_;
+      my $method = ($args{is} || '') eq 'ro'
+         ? sub {
+            Carp::confess("Cannot assign a value to a read-only accessor at reader ${caller}::${attribute}")
+               if $#_;
+            return $_[0]{$attribute};
+         }
+         : sub {
+            return $#_
+                  ? $_[0]{$attribute} = $_[1]
+                  : $_[0]{$attribute};
+         };
+
+      $class_metadata->{$attribute} = ();
+
+      # isa => Constaint,
+      if ( my $type_check = $args{isa} ) {
+         my $check_name = $type_check;
+         
+         if ( my ($aggregate_type, $inner_type) = $type_check =~ /\A(ArrayRef|Maybe)\[(.*)\]\z/ ) {
+            $type_check = Lmo::Types::_nested_constraints($attribute, $aggregate_type, $inner_type);
+         }
+         
+         my $check_sub = sub {
+            my ($new_val) = @_;
+            Lmo::Types::check_type_constaints($attribute, $type_check, $check_name, $new_val);
+         };
+         
+         $class_metadata->{$attribute}{isa} = [$check_name, $check_sub];
+         my $orig_method = $method;
+         $method = sub {
+            $check_sub->($_[1]) if $#_;
+            goto &$orig_method;
+         };
+      }
+
+      # XXX TODO: Inline builder and default into the actual method, for speed.
+      # builder => '_builder_method',
+      if ( my $builder = $args{builder} ) {
+         my $original_method = $method;
+         $method = sub {
+               $#_
+                  ? goto &$original_method
+                  : ! exists $_[0]{$attribute}
+                     ? $_[0]{$attribute} = $_[0]->$builder
+                     : goto &$original_method
+         };
+      }
+
+      # default => CodeRef,
+      if ( my $code = $args{default} ) {
+         Carp::confess("${caller}::${attribute}'s default is $code, but should be a coderef")
+               unless ref($code) eq 'CODE';
+         my $original_method = $method;
+         $method = sub {
+               $#_
+                  ? goto &$original_method
+                  : ! exists $_[0]{$attribute}
+                     ? $_[0]{$attribute} = $_[0]->$code
+                     : goto &$original_method
+         };
+      }
+
+      # does => 'Role',
+      if ( my $role = $args{does} ) {
+         my $original_method = $method;
+         $method = sub {
+            if ( $#_ ) {
+               Carp::confess(qq<Attribute ($attribute) doesn't consume a '$role' role">)
+                  unless Scalar::Util::blessed($_[1]) && eval { $_[1]->does($role) }
+            }
+            goto &$original_method
+         };
+      }
+
+      # coerce => CodeRef,
+      if ( my $coercion = $args{coerce} ) {
+         $class_metadata->{$attribute}{coerce} = $coercion;
+         my $original_method = $method;
+         $method = sub {
+            if ( $#_ ) {
+               return $original_method->($_[0], $coercion->($_[1]))
+            }
+            goto &$original_method;
+         }
+      }
+
+      # Actually put the attribute's accessor in the class
+      *{ _glob_for "${caller}::$attribute" } = $method;
+
+      if ( $args{required} ) {
+         $class_metadata->{$attribute}{required} = 1;
+      }
+
+      if ($args{clearer}) {
+         *{ _glob_for "${caller}::$args{clearer}" }
+            = sub { delete shift->{$attribute} }
+      }
+
+      if ($args{predicate}) {
+         *{ _glob_for "${caller}::$args{predicate}" }
+            = sub { exists shift->{$attribute} }
+      }
+
+      if ($args{handles}) {
+         _has_handles($caller, $attribute, \%args);
+      }
+
+      if (exists $args{init_arg}) {
+         $class_metadata->{$attribute}{init_arg} = $args{init_arg};
+      }
+   }
+}
+
+
+
+# handles handles
+sub _has_handles {
+   my ($caller, $attribute, $args) = @_;
+   my $handles = $args->{handles};
+
+   my $ref = ref $handles;
+   my $kv;
+   if ( $ref eq ref [] ) {
+         # handles => [ ... list of methods ... ],
+         $kv = { map { $_,$_ } @{$handles} };
+   }
+   elsif ( $ref eq ref {} ) {
+         # handles => { 'method_to_install' => 'original_method' | [ 'original_method', ... curried arguments ... ], },
+         $kv = $handles;
+   }
+   elsif ( $ref eq ref qr// ) {
+         # handles => qr/PAT/,
+         Carp::confess("Cannot delegate methods based on a Regexp without a type constraint (isa)")
+            unless $args->{isa};
+         my $target_class = $args->{isa};
+         $kv = {
+            map   { $_, $_     }
+            grep  { $_ =~ $handles }
+            grep  { !exists $Lmo::Object::{$_} && $target_class->can($_) }
+            grep  { $_ ne 'has' && $_ ne 'extends' }
+            keys %{ _stash_for $target_class }
+         };
+   }
+   else {
+         Carp::confess("handles for $ref not yet implemented");
+   }
+
+   while ( my ($method, $target) = each %{$kv} ) {
+         my $name = _glob_for "${caller}::$method";
+         Carp::confess("You cannot overwrite a locally defined method ($method) with a delegation")
+            if defined &$name;
+
+         # If we have an arrayref, they are currying some arguments.
+         my ($target, @curried_args) = ref($target) ? @$target : $target;
+         *$name = sub {
+            my $self        = shift;
+            my $delegate_to = $self->$attribute();
+            my $error = "Cannot delegate $method to $target because the value of $attribute";
+            Carp::confess("$error is not defined") unless $delegate_to;
+            Carp::confess("$error is not an object (got '$delegate_to')")
+               unless Scalar::Util::blessed($delegate_to) || (!ref($delegate_to) && $delegate_to->can($target));
+            return $delegate_to->$target(@curried_args, @_);
+         }
+   }
+}
+
+# Sets a package's @ISA to the list passed in. Overwrites any previous values.
+sub _set_package_isa {
+   my ($package, @new_isa) = @_;
+   my $package_isa  = \*{ _glob_for "${package}::ISA" };
+   # This somewhat weirder syntax is here to work around a Perl 5.10.0 bug;
+   # For whatever reason, some other variants weren't setting ISA.
+   @{*$package_isa} = @new_isa;
+}
+
+# Each class has its own metadata. When a class inhyerits attributes,
+# it should also inherit the attribute metadata.
+sub _set_inherited_metadata {
+   my $class = shift;
+   my $class_metadata = Lmo::Meta->metadata_for($class);
+   my $linearized_isa = mro::get_linear_isa($class);
+   my %new_metadata;
+
+   # Walk @ISA in reverse, grabbing the metadata for each
+   # class. Attributes with the same name defined in more
+   # specific classes override their parent's attributes.
+   for my $isa_class (reverse @$linearized_isa) {
+      my $isa_metadata = Lmo::Meta->metadata_for($isa_class);
+      %new_metadata = (
+         %new_metadata,
+         %$isa_metadata,
+      );
+   }
+   %$class_metadata = %new_metadata;
+}
+
+sub unimport {
+   my $caller = scalar caller();
+   my $stash  = _stash_for( $caller );
+
+   delete $stash->{$_} for @{$export_for{$caller}};
+}
+
+sub Dumper {
+   require Data::Dumper;
+   local $Data::Dumper::Indent    = 0;
+   local $Data::Dumper::Sortkeys  = 0;
+   local $Data::Dumper::Quotekeys = 0;
+   local $Data::Dumper::Terse     = 1;
+
+   Data::Dumper::Dumper(@_)
+}
+
+BEGIN {
+   # mro is the method resolution order. The module itself is core in
+   # recent Perls; In older Perls it's available from MRO::Compat from
+   # CPAN, and in case that isn't available to us, we inline the barest
+   # funcionality.
+   if ($] >= 5.010) {
+      { local $@; require mro; }
+   }
+   else {
+      local $@;
+      eval {
+         require MRO::Compat;
+      } or do {
+         *mro::get_linear_isa = *mro::get_linear_isa_dfs = sub {
+            no strict 'refs';
+
+            my $classname = shift;
+
+            my @lin = ($classname);
+            my %stored;
+            foreach my $parent (@{"$classname\::ISA"}) {
+               my $plin = mro::get_linear_isa_dfs($parent);
+               foreach (@$plin) {
+                     next if exists $stored{$_};
+                     push(@lin, $_);
+                     $stored{$_} = 1;
+               }
+            }
+            return \@lin;
+         };
+      }
+   }
+}
+
+}
+1;
+# ###########################################################################
+# End Lmo package
+# ###########################################################################

lib/Lmo/Meta.pm

@@ -0,0 +1,57 @@
+use strict;
+use warnings qw( FATAL all );
+
+use Carp ();
+use Scalar::Util qw(looks_like_number blessed);
+
+{
+   package Lmo::Meta;
+   my %metadata_for;
+
+   sub new {
+      shift;
+      return Lmo::Meta::Class->new(@_);
+   }
+   
+   sub metadata_for {
+      my $self    = shift;
+      my ($class) = @_;
+
+      return $metadata_for{$class} ||= {};
+   }
+}
+
+{
+   package Lmo::Meta::Class;
+
+   sub new {
+      my $class = shift;
+      return bless { @_ }, $class
+   }
+
+   sub class { shift->{class} }
+
+   sub attributes {
+      my $self = shift;
+      return keys %{Lmo::Meta->metadata_for($self->class)}
+   }
+
+   sub attributes_for_new {
+      my $self = shift;
+      my @attributes;
+
+      my $class_metadata = Lmo::Meta->metadata_for($self->class);
+      while ( my ($attr, $meta) = each %$class_metadata ) {
+         if ( exists $meta->{init_arg} ) {
+            push @attributes, $meta->{init_arg}
+                  if defined $meta->{init_arg};
+         }
+         else {
+            push @attributes, $attr;
+         }
+      }
+      return @attributes;
+   }
+}
+
+1;

lib/Lmo/Object.pm

@@ -0,0 +1,104 @@
+# Mo::Object is the parent of every Mo-derived object. Here's where new
+# and BUILDARGS gets inherited from.
+package Lmo::Object;
+
+use strict;
+use warnings qw( FATAL all );
+
+use Carp ();
+use Scalar::Util qw(looks_like_number blessed);
+
+use Lmo::Meta;
+
+{
+   # Gets the glob from a given string.
+   no strict 'refs';
+   sub _glob_for {
+      return \*{shift()}
+   }
+}
+
+sub new {
+   my $class = shift;
+   my $args  = $class->BUILDARGS(@_);
+
+   my $class_metadata = Lmo::Meta->metadata_for($class);
+
+   my @args_to_delete;
+   while ( my ($attr, $meta) = each %$class_metadata ) {
+      next unless exists $meta->{init_arg};
+      my $init_arg = $meta->{init_arg};
+
+      # If init_arg is defined, then we
+      if ( defined $init_arg ) {
+         $args->{$attr} = delete $args->{$init_arg};
+      }
+      else {
+         push @args_to_delete, $attr;
+      }
+   }
+
+   delete $args->{$_} for @args_to_delete;
+
+   for my $attribute ( keys %$args ) {
+      # coerce
+      if ( my $coerce = $class_metadata->{$attribute}{coerce} ) {
+         $args->{$attribute} = $coerce->($args->{$attribute});
+      }
+      # isa
+      if ( my $isa_check = $class_metadata->{$attribute}{isa} ) {
+         my ($check_name, $check_sub) = @$isa_check;
+         $check_sub->($args->{$attribute});
+      }
+   }
+
+   while ( my ($attribute, $meta) = each %$class_metadata ) {
+      next unless $meta->{required};
+      Carp::confess("Attribute ($attribute) is required for $class")
+         if ! exists $args->{$attribute}
+   }
+
+   my $self = bless $args, $class;
+
+   # BUILD
+   my @build_subs;
+   my $linearized_isa = mro::get_linear_isa($class);
+
+   for my $isa_class ( @$linearized_isa ) {
+      unshift @build_subs, *{ _glob_for "${isa_class}::BUILD" }{CODE};
+   }
+   # If &class::BUILD exists, for every class in
+   # the linearized ISA, call it.
+   # XXX I _think_ that this uses exists correctly, since
+   # a class could define a stub for BUILD and then AUTOLOAD
+   # the body. Should check what Moose does.
+   my @args = %$args;
+   for my $sub (grep { defined($_) && exists &$_ } @build_subs) {
+      # @args must be defined outside of this loop,
+      # as changes to @_ in one BUILD should propagate to another
+      $sub->( $self, @args);
+   }
+   return $self;
+}
+
+# Base BUILDARGS.
+sub BUILDARGS {
+   shift; # No need for the classname
+   if ( @_ == 1 && ref($_[0]) ) {
+      Carp::confess("Single parameters to new() must be a HASH ref, not $_[0]")
+         unless ref($_[0]) eq ref({});
+      return {%{$_[0]}} # We want a new reference, always
+   }
+   else {
+      return { @_ };
+   }
+}
+
+sub meta {
+   my $class = shift;
+   $class = Scalar::Util::blessed($class) || $class;
+   return Lmo::Meta->new(class => $class);
+}
+
+
+1;

lib/Lmo/Types.pm

@@ -0,0 +1,98 @@
+package Lmo::Types;
+
+use strict;
+use warnings qw( FATAL all );
+
+use Carp ();
+use Scalar::Util qw(looks_like_number blessed);
+
+# Basic types for isa. If you want a new type, either add it here,
+# or give isa a coderef.
+
+our %TYPES = (
+   Bool   => sub { !$_[0] || (defined $_[0] && looks_like_number($_[0]) && $_[0] == 1) },
+   Num    => sub { defined $_[0] && looks_like_number($_[0]) },
+   Int    => sub { defined $_[0] && looks_like_number($_[0]) && $_[0] == int($_[0]) },
+   Str    => sub { defined $_[0] },
+   Object => sub { defined $_[0] && blessed($_[0]) },
+   FileHandle => sub { local $@; require IO::Handle; fileno($_[0]) && $_[0]->opened },
+
+   map {
+      my $type = /R/ ? $_ : uc $_;
+      $_ . "Ref" => sub { ref $_[0] eq $type }
+   } qw(Array Code Hash Regexp Glob Scalar)
+);
+
+sub check_type_constaints {
+   my ($attribute, $type_check, $check_name, $val) = @_;
+   ( ref($type_check) eq 'CODE'
+      ? $type_check->($val)
+      : (ref $val eq $type_check
+         || ($val && $val eq $type_check)
+         || (exists $TYPES{$type_check} && $TYPES{$type_check}->($val)))
+   )
+   || Carp::confess(
+        qq<Attribute ($attribute) does not pass the type constraint because: >
+      . qq<Validation failed for '$check_name' with value >
+      . (defined $val ? Lmo::Dumper($val) : 'undef') )
+}
+
+# Nested (or parametized) constraints look like this: ArrayRef[CONSTRAINT] or
+# Maybe[CONSTRAINT]. This function returns a coderef that implements one of
+# these.
+sub _nested_constraints {
+   my ($attribute, $aggregate_type, $type) = @_;
+
+   my $inner_types;
+   if ( $type =~ /\A(ArrayRef|Maybe)\[(.*)\]\z/ ) {
+      # If the inner constraint -- the part within brackets -- is also a parametized
+      # constraint, then call this function recursively.
+      $inner_types = _nested_constraints($1, $2);
+   }
+   else {
+      # Otherwise, try checking if it's one of the built-in types.
+      $inner_types = $TYPES{$type};
+   }
+
+   if ( $aggregate_type eq 'ArrayRef' ) {
+      return sub {
+         my ($val) = @_;
+         return unless ref($val) eq ref([]);
+
+         if ($inner_types) {
+            for my $value ( @{$val} ) {
+               return unless $inner_types->($value)
+            }
+         }
+         else {
+            # $inner_types isn't set, we are dealing with a class name.
+            for my $value ( @{$val} ) {
+               return unless $value && ($value eq $type
+                        || (Scalar::Util::blessed($value) && $value->isa($type)));
+            }
+         }
+         return 1;
+      };
+   }
+   elsif ( $aggregate_type eq 'Maybe' ) {
+      return sub {
+         my ($value) = @_;
+         # For Maybe, undef is valid
+         return 1 if ! defined($value);
+         # Otherwise, defer to the inner type
+         if ($inner_types) {
+            return unless $inner_types->($value)
+         }
+         else {
+            return unless $value eq $type
+                        || (Scalar::Util::blessed($value) && $value->isa($type));
+         }
+         return 1;
+      }
+   }
+   else {
+      Carp::confess("Nested aggregate types are only implemented for ArrayRefs and Maybe");
+   }
+}
+
+1;

t/lib/Lmo/Bar.pm

@@ -1,4 +1,4 @@
 package Bar;
-use Mo;
+use Lmo;
 extends 'Foo';
 1;

t/lib/Lmo/Boo.pm

@@ -1,5 +1,5 @@
 package Boo;
-use Mo;
+use Lmo;
 
 has 'buff';
 

t/lib/Lmo/Foo.pm

@@ -1,5 +1,5 @@
 package Foo;
-use Mo;
+use Lmo;
 
 has 'stuff';
 

t/lib/Lmo/build.t

@@ -14,31 +14,31 @@ use Test::More;
 $main::count = 1;
 
 package Foo;
-use Mo 'build';
+use Lmo 'build';
 has 'foo' => (is => 'rw');
 sub BUILD {
     my $self = shift;
-    ::is_deeply(\@_, [qw(stuff 1)], "Foo's BUILD doesn't get the class name");
+    ::is_deeply([sort @_], [sort qw(stuff 1)], "Foo's BUILD doesn't get the class name");
     $self->foo($main::count++);
 }
 
 package Bar;
-use Mo;
+use Lmo;
 extends 'Foo';
 has 'bar' => (is => 'rw');
 
 package Baz;
-use Mo;
+use Lmo;
 extends 'Bar';
 has 'baz' => (is => 'rw');
 sub BUILD {
     my $self = shift;
-    ::is_deeply(\@_, [qw(stuff 1)], "Baz's BUILD doesn't get the class name");
+    ::is_deeply([sort @_], [sort qw(stuff 1)], "Baz's BUILD doesn't get the class name");
     $self->baz($main::count++);
 }
 
 package Gorch;
-use Mo;
+use Lmo;
 extends 'Baz';
 has 'gorch' => (is => 'rw');
 

t/lib/Lmo/buildargs.t

@@ -15,13 +15,13 @@ $main::count = 0;
 
 {
    package Nothing;
-   use Mo;
+   use Lmo;
    has nothing_special => ( is => 'rw' );
 }
 ok(Nothing->can("BUILDARGS"), "Every class automatically gets buildargs");
 
 package Foo;
-use Mo;
+use Lmo;
 has 'foo' => (is => 'rw');
 sub BUILDARGS {
     my $class = shift;
@@ -30,12 +30,12 @@ sub BUILDARGS {
 }
 
 package Bar;
-use Mo;
+use Lmo;
 extends 'Foo';
 has 'bar' => (is => 'rw');
 
 package Baz;
-use Mo;
+use Lmo;
 extends 'Bar';
 has 'baz' => (is => 'rw');
 sub BUILDARGS {
@@ -45,7 +45,7 @@ sub BUILDARGS {
 }
 
 package Gorch;
-use Mo;
+use Lmo;
 extends 'Baz';
 has 'gorch' => (is => 'rw');
 
@@ -53,7 +53,7 @@ package main;
 
 $main::count = 0;
 my $g = Foo->new;
-is $main::count, 1, "A class with no explicit parent inherits SUPER::BUILDARGS from Mo::Object";
+is $main::count, 1, "A class with no explicit parent inherits SUPER::BUILDARGS from Lmo::Object";
 
 $main::count = 0;
 $g = Gorch->new;

t/lib/Lmo/coerce.t

@@ -12,7 +12,7 @@ use English qw(-no_match_vars);
 use Test::More;
 
 package Foo::coerce;
-use Mo;
+use Lmo;
 
 has 'stuff' => (coerce => sub { uc $_[0] });
 

t/lib/Lmo/extends.t

@@ -11,7 +11,7 @@ use warnings FATAL => 'all';
 use English qw(-no_match_vars);
 use Test::More;
 
-use lib "$ENV{PERCONA_TOOLKIT_BRANCH}/t/lib/Mo";
+use lib "$ENV{PERCONA_TOOLKIT_BRANCH}/t/lib/Lmo";
 use Bar;
 
 my $b = Bar->new;

t/lib/Lmo/handles.t

@@ -21,14 +21,14 @@ use Test::More;
 
 {
     package Foo;
-    use Mo qw(is required handles default builder);
+    use Lmo qw(is required handles default builder);
 
     has 'bar' => (is => 'rw', default => sub { 10 });
 
     sub baz { 42 }
 
     package Bar;
-    use Mo qw(is required handles default builder);
+    use Lmo qw(is required handles default builder);
 
     has 'foo' => (
         is      => 'rw',
@@ -99,13 +99,13 @@ is($bar->foo_bar, 20, '... correctly curried a single argument');
 
 {
     package Engine;
-    use Mo qw(is required handles default builder);
+    use Lmo qw(is required handles default builder);
 
     sub go   { 'Engine::go'   }
     sub stop { 'Engine::stop' }
 
     package Car;
-    use Mo qw(is required handles default builder);
+    use Lmo qw(is required handles default builder);
 
     has 'engine' => (
         is      => 'rw',
@@ -137,14 +137,14 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
 
 {
     package Baz;
-    use Mo qw(is required handles default builder);
+    use Lmo qw(is required handles default builder);
 
     sub foo { 'Baz::foo' }
     sub bar { 'Baz::bar' }
     sub boo { 'Baz::boo' }
 
     package Baz::Proxy1;
-    use Mo qw(is required handles default builder);
+    use Lmo qw(is required handles default builder);
 
     has 'baz' => (
         is      => 'ro',
@@ -154,7 +154,7 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
     );
 
     package Baz::Proxy2;
-    use Mo qw(is required handles default builder);
+    use Lmo qw(is required handles default builder);
 
     has 'baz' => (
         is      => 'ro',
@@ -164,7 +164,7 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
     );
 
     package Baz::Proxy3;
-    use Mo qw(is required handles default builder);
+    use Lmo qw(is required handles default builder);
 
     has 'baz' => (
         is      => 'ro',
@@ -228,14 +228,14 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
     requires 'bar';
 
     package Foo::Baz;
-    use Mo qw(is required handles default builder);
+    use Lmo qw(is required handles default builder);
 
     sub foo { 'Foo::Baz::FOO' }
     sub bar { 'Foo::Baz::BAR' }
     sub baz { 'Foo::Baz::BAZ' }
 
     package Foo::Thing;
-    use Mo qw(is required handles default builder);
+    use Lmo qw(is required handles default builder);
 
     has 'thing' => (
         is      => 'rw',
@@ -244,7 +244,7 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
     );
 
     package Foo::OtherThing;
-    use Mo qw(is required handles default builder);
+    use Lmo qw(is required handles default builder);
     use Moose::Util::TypeConstraints;
 
     has 'other_thing' => (
@@ -288,7 +288,7 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
 
 {
     package Foo::Autoloaded;
-    use Mo qw(is required handles default builder);
+    use Lmo qw(is required handles default builder);
     
     sub AUTOLOAD {
         my $self = shift;
@@ -304,7 +304,7 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
     }
 
     package Bar::Autoloaded;
-    use Mo qw(is required handles default builder);
+    use Lmo qw(is required handles default builder);
 
     has 'foo' => (
         is      => 'rw',
@@ -313,7 +313,7 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
     );
 
     package Baz::Autoloaded;
-    use Mo qw(is required handles default builder);
+    use Lmo qw(is required handles default builder);
 
     has 'foo' => (
         is      => 'rw',
@@ -322,7 +322,7 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
     );
 
     package Goorch::Autoloaded;
-    use Mo qw(is required handles default builder);
+    use Lmo qw(is required handles default builder);
 
     eval {
         has 'foo' => (
@@ -447,7 +447,7 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
 
 {
     package Delegator;
-    use Mo qw(is required handles default builder);
+    use Lmo qw(is required handles default builder);
 
     sub full { 1 }
     sub stub;

t/lib/Lmo/init_arg.t

@@ -15,7 +15,7 @@ use Test::More;
 
 {
     package Foo;
-    use Mo qw( is init_arg );
+    use Lmo qw( is init_arg );
 
     eval {
         has 'foo' => (
@@ -64,7 +64,7 @@ use Test::More;
 
 {
     package Foo2;
-    use Mo qw( is init_arg clearer default );
+    use Lmo qw( is init_arg clearer default );
 
     my $counter;
     eval {

t/lib/Lmo/is.t

@@ -12,7 +12,7 @@ use English qw(-no_match_vars);
 use Test::More;
 
 package Foo::is;
-use Mo qw(is);
+use Lmo qw(is);
 
 has 'stuff' => (is => 'ro');
 

t/lib/Lmo/isa.t

@@ -29,7 +29,7 @@ sub lives_ok (&;$) {
 }
 
 package Foo::isa;
-use Mo qw(isa);
+use Lmo qw(isa);
 
 my @types = qw(Bool Num Int Str ArrayRef CodeRef HashRef RegexpRef);
 my @refs = ([], sub { }, {}, qr( ));
@@ -191,11 +191,11 @@ my $thisperl = $^X;
 if ($^O ne 'VMS')
    {$thisperl .= $Config{_exe} unless $thisperl =~ m/$Config{_exe}$/i;}
 
-my $pm_test = "$PerconaTest::trunk/t/lib/Mo/isa_subtest.pm";
+my $pm_test = "$PerconaTest::trunk/t/lib/Lmo/isa_subtest.pm";
    
 ok(
    scalar(IPC::Cmd::run(command => [$thisperl, $pm_test])),
-   "Mo types work with Scalar::Util::PP",
+   "Lmo types work with Scalar::Util::PP",
 );
 
 done_testing;

t/lib/Lmo/isa_subtest.pm

@@ -16,7 +16,7 @@ use warnings;
 
 {
    package isa_subtest;
-   use Mo;
+   use Lmo;
 
    has attr => (
       is  => 'rw',

t/lib/Lmo/meta.t

@@ -0,0 +1,83 @@
+#!/usr/bin/perl
+
+BEGIN {
+   die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
+      unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
+   unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
+};
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use Test::More;
+
+sub throws_ok (&;$) {
+   my ( $code, $pat, $msg ) = @_;
+   eval { $code->(); };
+   like ( $EVAL_ERROR, $pat, $msg );
+}
+
+{
+   package Metatest;
+   use Lmo;
+
+   has stuff => ( is => 'rw', required => 1 );
+   has init_stuff1 => ( is => 'rw', init_arg => undef );
+   has init_stuff2 => ( is => 'rw', init_arg => 'fancy_name' );
+}
+{
+package Metatest::child;
+   use Lmo;
+   extends 'Metatest';
+
+   has more_stuff => ( is => 'rw' );
+}
+
+my $obj = Metatest->new( stuff => 100 );
+
+can_ok($obj, 'meta');
+
+my $meta = $obj->meta();
+
+is_deeply(
+   [ sort $meta->attributes ],
+   [ sort qw(stuff init_stuff1 init_stuff2) ],
+   "->attributes works"
+);
+
+is_deeply(
+   [ sort $meta->attributes_for_new ],
+   [ sort qw(stuff fancy_name) ],
+   "->attributes_for_new works"
+);
+
+# Do these BEFORE initializing ::extends
+my $meta2 = Metatest::child->meta();
+is_deeply(
+   [ sort $meta2->attributes ],
+   [ sort qw(stuff init_stuff1 init_stuff2 more_stuff) ],
+   "->attributes works on a child class"
+);
+
+is_deeply(
+   [ sort $meta2->attributes_for_new ],
+   [ sort qw(stuff fancy_name more_stuff) ],
+   "->attributes_for_new works in a child class"
+);
+
+my $meta3 = Metatest::child->new(stuff => 10)->meta();
+is_deeply(
+   [ sort $meta3->attributes ],
+   [ sort qw(stuff init_stuff1 init_stuff2 more_stuff) ],
+   "->attributes works on an initialized child class"
+);
+
+is_deeply(
+   [ sort $meta3->attributes_for_new ],
+   [ sort qw(stuff fancy_name more_stuff) ],
+   "->attributes_for_new works in an initialized child class"
+);
+
+throws_ok { Metatest::child->new() } qr/\QAttribute (stuff) is required for Metatest::child/;
+
+done_testing;

t/lib/Lmo/object.t

@@ -10,7 +10,7 @@ use strict;
 use warnings FATAL => 'all';
 use English qw(-no_match_vars);
 use Test::More;
-use lib "$ENV{PERCONA_TOOLKIT_BRANCH}/t/lib/Mo";
+use lib "$ENV{PERCONA_TOOLKIT_BRANCH}/t/lib/Lmo";
 
 { package Clean; use Foo; }
 

t/lib/Lmo/required.t

@@ -13,14 +13,14 @@ use Test::More;
 
 #============
 package Foo::required;
-use Mo qw(required);
+use Lmo qw(required);
 
 has 'stuff' => (required => 1);
 has 'stuff2' => (required => 1);
 has 'foo' => ();
 #============
 package Foo::required_is;
-use Mo qw(required);
+use Lmo qw(required);
 
 has 'stuff' => (required => 1, is => 'ro');
 #============
@@ -28,7 +28,7 @@ has 'stuff' => (required => 1, is => 'ro');
 package main;
 
 my $f0 = eval { Foo::required->new(stuff2 => 'foobar') };
-like $@, qr/^\QAttribute (stuff) is required/, 'Mo dies when a required value is not provided';
+like $@, qr/^\QAttribute (stuff) is required/, 'Lmo dies when a required value is not provided';
 
 my $f = Foo::required->new(stuff => 'fubar', stuff2 => 'foobar');
 is $f->stuff, 'fubar', 'Object is correctly initialized when required values are provided';

t/lib/Lmo/strict.t

@@ -11,9 +11,9 @@ use warnings FATAL => 'all';
 use English qw(-no_match_vars);
 use Test::More;
 
-eval 'package Foo; use Mo; $x = 1';
+eval 'package Foo; use Lmo; $x = 1';
 
 like $@, qr/Global symbol "\$x" requires explicit package name/,
-    'Mo is strict';
+    'Lmo is strict';
 
 done_testing;

t/lib/Lmo/test.t

@@ -13,18 +13,18 @@ use Test::More;
 
 #============
 package Foo;
-use Mo;
+use Lmo;
 
 has 'this';
 
 #============
 package main;
 
-ok defined(&Foo::has), 'Mo exports has';
+ok defined(&Foo::has), 'Lmo exports has';
-ok defined(&Foo::extends), 'Mo exports extends';
+ok defined(&Foo::extends), 'Lmo exports extends';
-ok not(defined(&Foo::new)), 'Mo does not export new';
+ok not(defined(&Foo::new)), 'Lmo does not export new';
-ok 'Foo'->isa('Mo::Object'), 'Foo isa Mo::Object';
+ok 'Foo'->isa('Lmo::Object'), 'Foo isa Lmo::Object';
-is "@Foo::ISA", "Mo::Object", '@Foo::ISA is Mo::Object';
+is "@Foo::ISA", "Lmo::Object", '@Foo::ISA is Lmo::Object';
 ok 'Foo'->can('new'), 'Foo can new';
 ok 'Foo'->can('this'), 'Foo can this';
 
@@ -50,7 +50,7 @@ ok not(defined($f->{this})), '{this} is not defined';
 
 #============
 package Bar;
-use Mo 'builder', 'default';
+use Lmo 'builder', 'default';
 extends 'Foo';
 
 has 'that';
@@ -70,7 +70,7 @@ has guess => (
 #============
 package main;
 
-ok 'Bar'->isa('Mo::Object'), 'Bar isa Mo::Object';
+ok 'Bar'->isa('Lmo::Object'), 'Bar isa Lmo::Object';
 ok 'Bar'->isa('Foo'), 'Bar isa Foo';
 is "@Bar::ISA", 'Foo', '@Bar::ISA is Foo';
 ok 'Bar'->can('new'), 'Bar can new';
@@ -85,7 +85,7 @@ my $b = Bar->new(
 
 is ref($b), 'Bar', 'Object created';
 ok $b->isa('Foo'), 'Inheritance works';
-ok $b->isa('Mo::Object'), 'Bar isa Mo::Object since Foo isa Mo::Object';
+ok $b->isa('Lmo::Object'), 'Bar isa Lmo::Object since Foo isa Lmo::Object';
 is $b->this, 'thing', 'Read works in parent class';
 is $b->that, 'thong', 'Read works in current class';
 is ref($b->them), 'ARRAY', 'default works';
@@ -103,7 +103,7 @@ is $b->guess, 'me me me', 'default trumps builder';
 
 #============
 package Baz;
-use Mo 'build';
+use Lmo 'build';
 
 has 'foo';
 
@@ -114,7 +114,7 @@ sub BUILD {
 
 #============
 package Maz;
-use Mo;
+use Lmo;
 extends 'Baz';
 
 has 'bar';