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, $use_storage_state) = @_;
  40
  41   my (@ids, @missing);
  42
  43   for ($self->_pri_cols) {
  44     push @ids, ($use_storage_state and exists $self->{_column_data_in_storage}{$_})
  45       ? $self->{_column_data_in_storage}{$_}
  46       : $self->get_column($_)
  47     ;
  48     push @missing, $_ if (! defined $ids[-1] and ! $self->has_column_loaded ($_) );
  49   }
  50
  51   if (@missing && $self->in_storage) {
  52     $self->throw_exception (
  53       'Unable to uniquely identify row object with missing PK columns: '
  54       . join (', ', @missing )
  55     );
  56   }
  57
  58   return @ids;
  59 }
  60
  61 =head2 ID
  62
  63 Returns a unique id string identifying a row object by primary key.
  64 Used by L<DBIx::Class::CDBICompat::LiveObjectIndex> and
  65 L<DBIx::Class::ObjectCache>.
  66
  67 =over
  68
  69 =item WARNING
  70
  71 The default C<_create_ID> method used by this function orders the returned
  72 values by the alphabetical order of the primary column names, B<unlike>
  73 the L</id> method, which follows the same order in which columns were fed
  74 to L<DBIx::Class::ResultSource/set_primary_key>.
  75
  76 =back
  77
  78 =cut
  79
  80 sub ID {
  81   my ($self) = @_;
  82   $self->throw_exception( "Can't call ID() as a class method" )
  83     unless ref $self;
  84   return undef unless $self->in_storage;
  85   return $self->_create_ID(%{$self->ident_condition});
  86 }
  87
  88 sub _create_ID {
  89   my ($self, %vals) = @_;
  90   return undef unless 0 == grep { !defined } values %vals;
  91   return join '|', ref $self || $self, $self->result_source->name,
  92     map { $_ . '=' . $vals{$_} } sort keys %vals;
  93 }
  94
  95 =head2 ident_condition
  96
  97   my $cond = $result_source->ident_condition();
  98
  99   my $cond = $result_source->ident_condition('alias');
 100
 101 Produces a condition hash to locate a row based on the primary key(s).
 102
 103 =cut
 104
 105 sub ident_condition {
 106   shift->_mk_ident_cond(@_);
 107 }
 108
 109 sub _storage_ident_condition {
 110   shift->_mk_ident_cond(shift, 1);
 111 }
 112
 113 sub _mk_ident_cond {
 114   my ($self, $alias, $use_storage_state) = @_;
 115
 116   my @pks = $self->_pri_cols;
 117   my @vals = $self->_ident_values($use_storage_state);
 118
 119   my (%cond, @undef);
 120   my $prefix = defined $alias ? $alias.'.' : '';
 121   for my $col (@pks) {
 122     if (! defined ($cond{$prefix.$col} = shift @vals) ) {
 123       push @undef, $col;
 124     }
 125   }
 126
 127   if (@undef && $self->in_storage) {
 128     $self->throw_exception (
 129       'Unable to construct row object identity condition due to NULL PK columns: '
 130       . join (', ', @undef)
 131     );
 132   }
 133
 134   return \%cond;
 135 }
 136
 137 1;
 138
 139 =head1 AUTHORS
 140
 141 Matt S. Trout <mst@shadowcatsystems.co.uk>
 142
 143 =head1 LICENSE
 144
 145 You may distribute this code under the same terms as Perl itself.
 146
 147 =cut
 148