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 sub _ident_values {
  24   my ($self) = @_;
  25   return (map { $self->{_column_data}{$_} } $self->primary_columns);
  26 }
  27
  28 =head2 discard_changes
  29
  30 Re-selects the row from the database, losing any changes that had
  31 been made.
  32
  33 =cut
  34
  35 sub discard_changes {
  36   my ($self) = @_;
  37   delete $self->{_dirty_columns};
  38   return unless $self->in_storage; # Don't reload if we aren't real!
  39   my ($reload) = $self->result_source->resultset->find
  40     (map { $self->$_ } $self->primary_columns);
  41   unless ($reload) { # If we got deleted in the mean-time
  42     $self->in_storage(0);
  43     return $self;
  44   }
  45   delete @{$self}{keys %$self};
  46   @{$self}{keys %$reload} = values %$reload;
  47   return $self;
  48 }
  49
  50 =head2 id
  51
  52 Returns the primary key(s) for a row. Can't be called as
  53 a class method.
  54
  55 =cut
  56
  57 sub id {
  58   my ($self) = @_;
  59   $self->throw_exception( "Can't call id() as a class method" )
  60     unless ref $self;
  61   my @pk = $self->_ident_values;
  62   return (wantarray ? @pk : $pk[0]);
  63 }
  64
  65 =head2 ID
  66
  67 Returns a unique id string identifying a row object by primary key.
  68 Used by L<DBIx::Class::CDBICompat::LiveObjectIndex> and
  69 L<DBIx::Class::ObjectCache>.
  70
  71 =cut
  72
  73 sub ID {
  74   my ($self) = @_;
  75   $self->throw_exception( "Can't call ID() as a class method" )
  76     unless ref $self;
  77   return undef unless $self->in_storage;
  78   return $self->_create_ID(map { $_ => $self->{_column_data}{$_} }
  79                              $self->primary_columns);
  80 }
  81
  82 sub _create_ID {
  83   my ($self,%vals) = @_;
  84   return undef unless 0 == grep { !defined } values %vals;
  85   return join '|', ref $self || $self, $self->result_source->name,
  86     map { $_ . '=' . $vals{$_} } sort keys %vals;
  87 }
  88
  89 =head2 ident_condition
  90
  91   my $cond = $result_source->ident_condition();
  92
  93   my $cond = $result_source->ident_condition('alias');
  94
  95 Produces a condition hash to locate a row based on the primary key(s).
  96
  97 =cut
  98
  99 sub ident_condition {
 100   my ($self, $alias) = @_;
 101   my %cond;
 102   my $prefix = defined $alias ? $alias.'.' : '';
 103   $cond{$prefix.$_} = $self->get_column($_) for $self->primary_columns;
 104   return \%cond;
 105 }
 106
 107 1;
 108
 109 =head1 AUTHORS
 110
 111 Matt S. Trout <mst@shadowcatsystems.co.uk>
 112
 113 =head1 LICENSE
 114
 115 You may distribute this code under the same terms as Perl itself.
 116
 117 =cut
 118