lib/MooseX/StrictConstructor.pm

   1 package MooseX::StrictConstructor;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '0.06_01';
   7 $VERSION = eval $VERSION;
   8
   9 use Class::MOP ();
  10 use Moose ();
  11 use Moose::Exporter;
  12 use MooseX::StrictConstructor::Role::Object;
  13 use MooseX::StrictConstructor::Role::Metaclass;
  14
  15 Moose::Exporter->setup_import_methods( also => 'Moose' );
  16
  17 sub init_meta
  18 {
  19     shift;
  20     my %p = @_;
  21
  22     Moose->init_meta(%p);
  23
  24     my $caller = $p{for_class};
  25
  26     my $old_meta = $caller->meta();
  27
  28     my $metameta = $old_meta->meta();
  29     unless ( $metameta->can('does_role')
  30              && $metameta->does_role( 'MooseX::StrictConstructor::Role::Metaclass' ) )
  31     {
  32         my $new_meta =
  33             Moose::Meta::Class->create_anon_class
  34                 ( superclasses => [ ref $caller->meta() ],
  35                   roles        => [ 'MooseX::StrictConstructor::Role::Metaclass' ],
  36                   cache        => 1,
  37                 );
  38
  39         Class::MOP::remove_metaclass_by_name($caller);
  40
  41         $new_meta->name()->initialize( $caller,
  42                                        map { $_ => $old_meta->$_() }
  43                                        qw( attribute_metaclass
  44                                            method_metaclass
  45                                            instance_metaclass
  46                                          )
  47                                      );
  48     }
  49
  50     unless ( $caller->meta()->does_role('MooseX::StrictConstructor::Role::Object') )
  51     {
  52         my $new_base =
  53             Moose::Meta::Class->create_anon_class
  54                 ( superclasses => [ $caller->meta()->superclasses() ],
  55                   roles        => [ 'MooseX::StrictConstructor::Role::Object' ],
  56                   cache        => 1,
  57                 );
  58
  59         $caller->meta()->superclasses( $new_base->name() );
  60     }
  61
  62     return $caller->meta();
  63 }
  64
  65 1;
  66
  67 __END__
  68
  69 =pod
  70
  71 =head1 NAME
  72
  73 MooseX::StrictConstructor - Make your object constructors blow up on unknown attributes
  74
  75 =head1 SYNOPSIS
  76
  77     package My::Class;
  78
  79     use MooseX::StrictConstructor; # instead of use Moose
  80
  81     has 'size' => ...;
  82
  83     # then later ...
  84
  85     # this blows up because color is not a known attribute
  86     My::Class->new( size => 5, color => 'blue' );
  87
  88 =head1 DESCRIPTION
  89
  90 Using this class to load Moose instead of just loading using Moose
  91 itself makes your constructors "strict". If your constructor is called
  92 with an attribute init argument that your class does not declare, then
  93 it calls "Carp::confess()". This is a great way to catch small typos.
  94
  95 =head2 Subverting Strictness
  96
  97 You may find yourself wanting to accept a parameter to the constructor
  98 that is not the name of an attribute.
  99
 100 In that case, you'll probably be writing a C<BUILD()> method to deal
 101 with it. Your C<BUILD()> method will receive two parameters, the new
 102 object, and a hash reference of parameters passed to the constructor.
 103
 104 If you delete keys from this hash reference, then they will not be
 105 seen when this class does its checking.
 106
 107   sub BUILD {
 108       my $self   = shift;
 109       my $params = shift;
 110
 111       if ( delete $params->{do_something} ) {
 112           ...
 113       }
 114   }
 115
 116 =head2 Caveats
 117
 118 Using this class replaces the default Moose meta class,
 119 C<Moose::Meta::Class>, with its own,
 120 C<MooseX::StrictConstructor::Meta::Class>. If you have your own meta
 121 class, this distro will probably not work for you.
 122
 123 =head1 AUTHOR
 124
 125 Dave Rolsky, C<< <autarch@urth.org> >>
 126
 127 =head1 BUGS
 128
 129 Please report any bugs or feature requests to
 130 C<bug-moosex-strictconstructor@rt.cpan.org>, or through the web
 131 interface at L<http://rt.cpan.org>.  I will be notified, and then
 132 you'll automatically be notified of progress on your bug as I make
 133 changes.
 134
 135 =head1 COPYRIGHT & LICENSE
 136
 137 Copyright 2007 Dave Rolsky, All Rights Reserved.
 138
 139 This program is free software; you can redistribute it and/or modify
 140 it under the same terms as Perl itself.
 141
 142 =cut