lib/DBIx/Class/CDBICompat/Constructor.pm

   1 package # hide from PAUSE
   2     DBIx::Class::CDBICompat::Constructor;
   3
   4 use strict;
   5 use warnings;
   6
   7 use base 'DBIx::Class::CDBICompat::ImaDBI';
   8
   9 use Carp;
  10 use DBIx::Class::_Util qw(quote_sub perlstring);
  11 use namespace::clean;
  12
  13 __PACKAGE__->set_sql(Retrieve => <<'');
  14 SELECT __ESSENTIAL__
  15 FROM   __TABLE__
  16 WHERE  %s
  17
  18 sub add_constructor {
  19     my ($class, $method, $fragment) = @_;
  20
  21     croak("constructors needs a name") unless $method;
  22
  23     carp("$method already exists in $class") && return
  24        if $class->can($method);
  25
  26     quote_sub "${class}::${method}" => sprintf( <<'EOC', perlstring $fragment );
  27       my $self = shift;
  28       $self->sth_to_objects($self->sql_Retrieve(%s), \@_);
  29 EOC
  30 }
  31
  32 1;