Commit | Line | Data |
c0e7b4e5 |
1 | package # hide from PAUSE |
2 | DBIx::Class::CDBICompat::Constructor; |
a3018bd3 |
3 | |
2e424e0c |
4 | use base qw(DBIx::Class::CDBICompat::ImaDBI); |
5 | |
8637bb24 |
6 | use Sub::Name(); |
7 | |
a3018bd3 |
8 | use strict; |
9 | use warnings; |
10 | |
2e424e0c |
11 | use Carp; |
12 | |
13 | __PACKAGE__->set_sql(Retrieve => <<''); |
14 | SELECT __ESSENTIAL__ |
15 | FROM __TABLE__ |
16 | WHERE %s |
17 | |
a3018bd3 |
18 | sub add_constructor { |
2e424e0c |
19 | my ($class, $method, $fragment) = @_; |
20 | return croak("constructors needs a name") unless $method; |
21 | |
22 | no strict 'refs'; |
23 | my $meth = "$class\::$method"; |
24 | return carp("$method already exists in $class") |
25 | if *$meth{CODE}; |
26 | |
8637bb24 |
27 | *$meth = Sub::Name::subname $meth => sub { |
2e424e0c |
28 | my $self = shift; |
29 | $self->sth_to_objects($self->sql_Retrieve($fragment), \@_); |
a3018bd3 |
30 | }; |
31 | } |
32 | |
33 | 1; |