lib/MooseX/StrictConstructor.pm

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