1 package Method::Generate::Constructor;
5 use base qw(Class::Tiny::Object);
8 sub register_attribute_spec {
9 my ($self, $name, $spec) = @_;
10 $self->{attribute_specs}{$name} = $spec;
15 my $package = $self->{package};
16 defer_sub "${package}::new" => sub {
17 unquote_sub $self->generate_method(
18 $package, 'new', $self->{attribute_specs}, { no_install => 1 }
25 my ($self, $into, $name, $spec, $quote_opts) = @_;
26 foreach my $no_init (grep !exists($spec->{$_}{init_arg}), keys %$spec) {
27 $spec->{$no_init}{init_arg} = $no_init;
29 my $body = ' my $class = shift;'."\n";
30 $body .= $self->_generate_args;
31 $body .= $self->_check_required($spec);
32 $body .= ' my $new = bless({}, $class);'."\n";
33 $body .= $self->_assign_new($spec);
34 $body .= ' return $new;'."\n";
36 "${into}::${name}" => $body,
37 (ref($quote_opts) ? ({}, $quote_opts) : ())
43 q{ my $args = ref($_[0]) eq 'HASH' ? $_[0] : { @_ };}."\n";
47 my ($self, $spec) = @_;
49 NAME: foreach my $name (keys %$spec) {
50 my $attr_spec = $spec->{$name};
52 next NAME unless defined(my $i = $attr_spec->{init_arg});
57 return '' unless @init;
58 ' @{$new}{qw('.join(' ',@slots).')} = @{$args}{qw('.join(' ',@init).')};'
63 my ($self, $spec) = @_;
65 map $spec->{$_}{init_arg},
66 grep $spec->{$_}{required},
68 return '' unless @required_init;
69 ' if (my @missing = grep !exists $args->{$_}, qw('
70 .join(' ',@required_init).')) {'."\n"
71 .q{ die "Missing required arguments: ".join(', ', sort @missing);}."\n"