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 strict;
   7 use warnings;
   8
   9 use Carp;
  10
  11 __PACKAGE__->set_sql(Retrieve => <<'');
  12 SELECT __ESSENTIAL__
  13 FROM   __TABLE__
  14 WHERE  %s
  15
  16 sub add_constructor {
  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), \@_);
  28     };
  29 }
  30
  31 1;