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