Add ability to use an arrayref with has() to create multiple attributes with the...
[gitmo/Moose.git] / lib / Moose / Object.pm
CommitLineData
fcd84ca9 1
2package Moose::Object;
3
4use strict;
5use warnings;
648e79ae 6
7use Moose::Meta::Class;
4c4fbe56 8use metaclass 'Moose::Meta::Class';
bc1e29b5 9
0677220d 10use Carp 'confess';
11
d44714be 12our $VERSION = '0.08';
13our $AUTHORITY = 'cpan:STEVAN';
fcd84ca9 14
15sub new {
2c0cbef7 16 my $class = shift;
8a157bab 17 my %params;
18 if (scalar @_ == 1) {
19 (ref($_[0]) eq 'HASH')
20 || confess "Single parameters to new() must be a HASH ref";
21 %params = %{$_[0]};
22 }
23 else {
24 %params = @_;
25 }
c0e30cf5 26 my $self = $class->meta->new_object(%params);
d7f17ebb 27 $self->BUILDALL(\%params);
c0e30cf5 28 return $self;
fcd84ca9 29}
30
c0e30cf5 31sub BUILDALL {
d44714be 32 # NOTE: we ask Perl if we even
33 # need to do this first, to avoid
34 # extra meta level calls
1f779926 35 return unless $_[0]->can('BUILD');
d7f17ebb 36 my ($self, $params) = @_;
6ba6d68c 37 foreach my $method (reverse $self->meta->find_all_methods_by_name('BUILD')) {
d7f17ebb 38 $method->{code}->($self, $params);
c0e30cf5 39 }
40}
41
42sub DEMOLISHALL {
d44714be 43 # NOTE: we ask Perl if we even
44 # need to do this first, to avoid
45 # extra meta level calls
1f779926 46 return unless $_[0]->can('DEMOLISH');
47 my $self = shift;
c0e30cf5 48 foreach my $method ($self->meta->find_all_methods_by_name('DEMOLISH')) {
5569c072 49 $method->{code}->($self);
c0e30cf5 50 }
51}
52
53sub DESTROY { goto &DEMOLISHALL }
54
ef333f17 55# new does() methods will be created
56# as approiate see Moose::Meta::Role
0677220d 57sub does {
bdabd620 58 my ($self, $role_name) = @_;
0677220d 59 (defined $role_name)
60 || confess "You much supply a role name to does()";
bdabd620 61 my $meta = $self->meta;
62 foreach my $class ($meta->class_precedence_list) {
63 return 1
64 if $meta->initialize($class)->does_role($role_name);
65 }
66 return 0;
0677220d 67}
ef333f17 68
f742dfef 69# RANT:
70# Cmon, how many times have you written
71# the following code while debugging:
72#
73# use Data::Dumper;
74# warn Dumper \%thing;
75#
76# It can get seriously annoying, so why
77# not just do this ...
78sub dump {
79 my $self = shift;
80 require Data::Dumper;
81 $Data::Dumper::Maxdepth = shift if @_;
82 Data::Dumper::Dumper $self;
83}
84
fcd84ca9 851;
86
87__END__
88
89=pod
90
91=head1 NAME
92
e522431d 93Moose::Object - The base object for Moose
fcd84ca9 94
fcd84ca9 95=head1 DESCRIPTION
96
6ba6d68c 97This serves as the base object for all Moose classes. Every
98effort will be made to ensure that all classes which C<use Moose>
99will inherit from this class. It provides a default constructor
100and destructor, which run all the BUILD and DEMOLISH methods in
101the class tree.
102
103You don't actually I<need> to inherit from this in order to
104use Moose though. It is just here to make life easier.
105
fcd84ca9 106=head1 METHODS
107
108=over 4
109
110=item B<meta>
111
6ba6d68c 112This will return the metaclass associated with the given class.
113
fcd84ca9 114=item B<new>
115
e522431d 116This will create a new instance and call C<BUILDALL>.
117
c0e30cf5 118=item B<BUILDALL>
119
d7f17ebb 120This will call every C<BUILD> method in the inheritance hierarchy,
121and pass it a hash-ref of the the C<%params> passed to C<new>.
e522431d 122
c0e30cf5 123=item B<DEMOLISHALL>
124
e522431d 125This will call every C<DEMOLISH> method in the inheritance hierarchy.
126
ef333f17 127=item B<does ($role_name)>
128
02a0fb52 129This will check if the invocant's class C<does> a given C<$role_name>.
130This is similar to C<isa> for object, but it checks the roles instead.
131
f742dfef 132=item B<dump ($maxdepth)>
133
134Cmon, how many times have you written the following code while debugging:
135
136 use Data::Dumper;
137 warn Dumper $obj;
138
139It can get seriously annoying, so why not just use this.
140
fcd84ca9 141=back
142
143=head1 BUGS
144
145All complex software has bugs lurking in it, and this module is no
146exception. If you find a bug please either email me, or add the bug
147to cpan-RT.
148
fcd84ca9 149=head1 AUTHOR
150
151Stevan Little E<lt>stevan@iinteractive.comE<gt>
152
153=head1 COPYRIGHT AND LICENSE
154
b77fdbed 155Copyright 2006, 2007 by Infinity Interactive, Inc.
fcd84ca9 156
157L<http://www.iinteractive.com>
158
159This library is free software; you can redistribute it and/or modify
160it under the same terms as Perl itself.
161
162=cut