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 @pk = $self->_ident_values;
  35   return (wantarray ? @pk : $pk[0]);
  36 }
  37
  38 sub _ident_values {
  39   my ($self) = @_;
  40   return (map { $self->{_column_data}{$_} } $self->primary_columns);
  41 }
  42
  43 =head2 ID
  44
  45 Returns a unique id string identifying a row object by primary key.
  46 Used by L<DBIx::Class::CDBICompat::LiveObjectIndex> and
  47 L<DBIx::Class::ObjectCache>.
  48
  49 =over
  50
  51 =item WARNING
  52
  53 The default C<_create_ID> method used by this function orders the returned
  54 values by the alphabetical order of the primary column names, B<unlike>
  55 the L</id> method, which follows the same order in which columns were fed
  56 to L<DBIx::Class::ResultSource/set_primary_key>.
  57
  58 =back
  59
  60 =cut
  61
  62 sub ID {
  63   my ($self) = @_;
  64   $self->throw_exception( "Can't call ID() as a class method" )
  65     unless ref $self;
  66   return undef unless $self->in_storage;
  67   return $self->_create_ID(map { $_ => $self->{_column_data}{$_} }
  68                              $self->primary_columns);
  69 }
  70
  71 sub _create_ID {
  72   my ($self,%vals) = @_;
  73   return undef unless 0 == grep { !defined } values %vals;
  74   return join '|', ref $self || $self, $self->result_source->name,
  75     map { $_ . '=' . $vals{$_} } sort keys %vals;
  76 }
  77
  78 =head2 ident_condition
  79
  80   my $cond = $result_source->ident_condition();
  81
  82   my $cond = $result_source->ident_condition('alias');
  83
  84 Produces a condition hash to locate a row based on the primary key(s).
  85
  86 =cut
  87
  88 sub ident_condition {
  89   my ($self, $alias) = @_;
  90   my %cond;
  91   my $prefix = defined $alias ? $alias.'.' : '';
  92   $cond{$prefix.$_} = $self->get_column($_) for $self->primary_columns;
  93   return \%cond;
  94 }
  95
  96 1;
  97
  98 =head1 AUTHORS
  99
 100 Matt S. Trout <mst@shadowcatsystems.co.uk>
 101
 102 =head1 LICENSE
 103
 104 You may distribute this code under the same terms as Perl itself.
 105
 106 =cut
 107