lib/DBIx/Class/CDBICompat/Constructor.pm

   1 package # hide from PAUSE
   2     DBIx::Class::CDBICompat::Constructor;
   3
   4 use base qw(DBIx::Class::CDBICompat::ImaDBI);
   5
   6 use Sub::Name();
   7
   8 use strict;
   9 use warnings;
  10
  11 use Carp;
  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     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
  27     *$meth = Sub::Name::subname $meth => sub {
  28             my $self = shift;
  29             $self->sth_to_objects($self->sql_Retrieve($fragment), \@_);
  30     };
  31 }
  32
  33 1;