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 | |
a3018bd3 |
6 | use strict; |
7 | use warnings; |
8 | |
2e424e0c |
9 | use Carp; |
10 | |
11 | __PACKAGE__->set_sql(Retrieve => <<''); |
12 | SELECT __ESSENTIAL__ |
13 | FROM __TABLE__ |
14 | WHERE %s |
15 | |
a3018bd3 |
16 | sub add_constructor { |
2e424e0c |
17 | my ($class, $method, $fragment) = @_; |
18 | return croak("constructors needs a name") unless $method; |
19 | |
20 | no strict 'refs'; |
21 | my $meth = "$class\::$method"; |
22 | return carp("$method already exists in $class") |
23 | if *$meth{CODE}; |
24 | |
25 | *$meth = sub { |
26 | my $self = shift; |
27 | $self->sth_to_objects($self->sql_Retrieve($fragment), \@_); |
a3018bd3 |
28 | }; |
29 | } |
30 | |
31 | 1; |