lib/DBIx/Class/PK.pm

   1 package DBIx::Class::PK;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw/Class::Data::Inheritable DBIx::Class::SQL/;
   7
   8 __PACKAGE__->mk_classdata('_primaries' => {});
   9
  10 sub _ident_cond {
  11   my ($class) = @_;
  12   return join(" AND ", map { "$_ = ?" } keys %{$class->_primaries});
  13 }
  14
  15 sub _ident_values {
  16   my ($self) = @_;
  17   return (map { $self->{_column_data}{$_} } keys %{$self->_primaries});
  18 }
  19
  20 sub set_primary {
  21   my ($class, @cols) = @_;
  22   my %pri;
  23   $pri{$_} = {} for @cols;
  24   $class->_primaries(\%pri);
  25 }
  26
  27 sub retrieve {
  28   my ($class, @vals) = @_;
  29   my @pk = keys %{$class->_primaries};
  30   die "Can't retrieve unless primary columns are defined" unless @pk;
  31   my $query;
  32   if (ref $vals[0] eq 'HASH') {
  33     $query = $vals[0];
  34   } elsif (@pk == 1 && @vals == 1) {
  35     return ($class->retrieve_from_sql($class->_ident_cond, $vals[0]))[0];
  36   } else {
  37     $query = {@vals};
  38   }
  39   die "Can't retrieve unless all primary keys are specified"
  40     unless (keys %$query >= @pk); # If we check 'em we run afoul of uc/lc
  41                                   # column names etc. Not sure what to do yet
  42   return ($class->search($query))[0];
  43 }
  44
  45 1;