Commit | Line | Data |
c0e7b4e5 |
1 | package # hide from PAUSE |
2 | DBIx::Class::CDBICompat::Constructor; |
a3018bd3 |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
8d73fcd4 |
7 | use base 'DBIx::Class::CDBICompat::ImaDBI'; |
8 | |
2e424e0c |
9 | use Carp; |
8d73fcd4 |
10 | use DBIx::Class::_Util qw(quote_sub perlstring); |
51ec0382 |
11 | use namespace::clean; |
2e424e0c |
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) = @_; |
2e424e0c |
20 | |
8d73fcd4 |
21 | croak("constructors needs a name") unless $method; |
22 | |
23 | carp("$method already exists in $class") && return |
24 | if $class->can($method); |
2e424e0c |
25 | |
8d73fcd4 |
26 | quote_sub "${class}::${method}" => sprintf( <<'EOC', perlstring $fragment ); |
27 | my $self = shift; |
28 | $self->sth_to_objects($self->sql_Retrieve(%s), \@_); |
29 | EOC |
a3018bd3 |
30 | } |
31 | |
32 | 1; |