lib/DBIx/Class/PK.pm

   1 package DBIx::Class::PK;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw/DBIx::Class::Row/;
   7
   8 =head1 NAME
   9
  10 DBIx::Class::PK - Primary Key class
  11
  12 =head1 SYNOPSIS
  13
  14 =head1 DESCRIPTION
  15
  16 This class contains methods for handling primary keys and methods
  17 depending on them.
  18
  19 =head1 METHODS
  20
  21 =cut
  22
  23 =head2 id
  24
  25 Returns the primary key(s) for a row. Can't be called as
  26 a class method.
  27
  28 =cut
  29
  30 sub id {
  31   my ($self) = @_;
  32   $self->throw_exception( "Can't call id() as a class method" )
  33     unless ref $self;
  34   my @id_vals = $self->_ident_values;
  35   return (wantarray ? @id_vals : $id_vals[0]);
  36 }
  37
  38 sub _ident_values {
  39   my ($self) = @_;
  40
  41   my (@ids, @missing);
  42
  43   for ($self->_pri_cols) {
  44     push @ids, $self->get_column($_);
  45     push @missing, $_ if (! defined $ids[-1] and ! $self->has_column_loaded ($_) );
  46   }
  47
  48   if (@missing && $self->in_storage) {
  49     $self->throw_exception (
  50       'Unable to uniquely identify row object with missing PK columns: '
  51       . join (', ', @missing )
  52     );
  53   }
  54
  55   return @ids;
  56 }
  57
  58 =head2 ID
  59
  60 Returns a unique id string identifying a row object by primary key.
  61 Used by L<DBIx::Class::CDBICompat::LiveObjectIndex> and
  62 L<DBIx::Class::ObjectCache>.
  63
  64 =over
  65
  66 =item WARNING
  67
  68 The default C<_create_ID> method used by this function orders the returned
  69 values by the alphabetical order of the primary column names, B<unlike>
  70 the L</id> method, which follows the same order in which columns were fed
  71 to L<DBIx::Class::ResultSource/set_primary_key>.
  72
  73 =back
  74
  75 =cut
  76
  77 sub ID {
  78   my ($self) = @_;
  79   $self->throw_exception( "Can't call ID() as a class method" )
  80     unless ref $self;
  81   return undef unless $self->in_storage;
  82   return $self->_create_ID(%{$self->ident_condition});
  83 }
  84
  85 sub _create_ID {
  86   my ($self, %vals) = @_;
  87   return undef unless 0 == grep { !defined } values %vals;
  88   return join '|', ref $self || $self, $self->result_source->name,
  89     map { $_ . '=' . $vals{$_} } sort keys %vals;
  90 }
  91
  92 =head2 ident_condition
  93
  94   my $cond = $result_source->ident_condition();
  95
  96   my $cond = $result_source->ident_condition('alias');
  97
  98 Produces a condition hash to locate a row based on the primary key(s).
  99
 100 =cut
 101
 102 sub ident_condition {
 103   my ($self, $alias) = @_;
 104
 105   my @pks = $self->_pri_cols;
 106   my @vals = $self->_ident_values;
 107
 108   my (%cond, @undef);
 109   my $prefix = defined $alias ? $alias.'.' : '';
 110   for my $col (@pks) {
 111     if (! defined ($cond{$prefix.$col} = shift @vals) ) {
 112       push @undef, $col;
 113     }
 114   }
 115
 116   if (@undef && $self->in_storage) {
 117     $self->throw_exception (
 118       'Unable to construct row object identity condition due to NULL PK columns: '
 119       . join (', ', @undef)
 120     );
 121   }
 122
 123   return \%cond;
 124 }
 125
 126 1;
 127
 128 =head1 AUTHORS
 129
 130 Matt S. Trout <mst@shadowcatsystems.co.uk>
 131
 132 =head1 LICENSE
 133
 134 You may distribute this code under the same terms as Perl itself.
 135
 136 =cut
 137