lib/MooseX/StrictConstructor/Role/Metaclass.pm

   1 package MooseX::StrictConstructor::Role::Metaclass;
   2
   3 use strict;
   4 use warnings;
   5
   6 use MooseX::StrictConstructor::Meta::Method::Constructor;
   7
   8 use Moose::Role;
   9
  10 has 'constructor_class' =>
  11     ( is         => 'ro',
  12       isa        => 'ClassName',
  13       lazy_build => 1,
  14     );
  15
  16 sub _build_constructor_class
  17 {
  18     return
  19         Moose::Meta::Class->create_anon_class
  20             ( superclasses => [ 'Moose::Meta::Method::Constructor' ],
  21               roles        => [ 'MooseX::StrictConstructor::Role::Constructor' ],
  22               cache        => 1,
  23             )->name();
  24 }
  25
  26 # If Moose::Meta::Class had a constructor_class attribute, this
  27 # wrapper would not be necessary.
  28 around 'make_immutable' => sub
  29 {
  30     my $orig = shift;
  31     my $self = shift;
  32
  33     return
  34         $self->$orig
  35             ( constructor_class => $self->constructor_class(),
  36               @_,
  37             );
  38 };
  39
  40 no Moose::Role;
  41
  42
  43 1;
  44
  45 __END__
  46
  47 =pod
  48
  49 =head1 NAME
  50
  51 MooseX::StrictConstructor::Meta::Class - A meta class for classes with strict constructors
  52
  53 =head1 SYNOPSIS
  54
  55   use MooseX::StrictConstructor;
  56
  57 =head1 DESCRIPTION
  58
  59 This class simply overrides C<make_immutable()> in
  60 C<Moose::Meta::Class> to use
  61 C<MooseX::StrictConstructor::Meta::Method::Constructor> as the
  62 constructor class.
  63
  64 You should never have to use this class directly.
  65
  66 =head1 AUTHOR
  67
  68 Dave Rolsky, C<< <autarch@urth.org> >>
  69
  70 =head1 COPYRIGHT & LICENSE
  71
  72 Copyright 2007 Dave Rolsky, All Rights Reserved.
  73
  74 This program is free software; you can redistribute it and/or modify
  75 it under the same terms as Perl itself.
  76
  77 =cut