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 This method can also be used to refresh from storage, retrieving any
  34 changes made since the row was last read from storage.
  35
  36 =cut
  37
  38 sub discard_changes {
  39   my ($self) = @_;
  40   delete $self->{_dirty_columns};
  41   return unless $self->in_storage; # Don't reload if we aren't real!
  42   my ($reload) = $self->result_source->resultset->find
  43     (map { $self->$_ } $self->primary_columns);
  44   unless ($reload) { # If we got deleted in the mean-time
  45     $self->in_storage(0);
  46     return $self;
  47   }
  48   delete @{$self}{keys %$self};
  49   @{$self}{keys %$reload} = values %$reload;
  50   return $self;
  51 }
  52
  53 =head2 id
  54
  55 Returns the primary key(s) for a row. Can't be called as
  56 a class method.
  57
  58 =cut
  59
  60 sub id {
  61   my ($self) = @_;
  62   $self->throw_exception( "Can't call id() as a class method" )
  63     unless ref $self;
  64   my @pk = $self->_ident_values;
  65   return (wantarray ? @pk : $pk[0]);
  66 }
  67
  68 =head2 ID
  69
  70 Returns a unique id string identifying a row object by primary key.
  71 Used by L<DBIx::Class::CDBICompat::LiveObjectIndex> and
  72 L<DBIx::Class::ObjectCache>.
  73
  74 =cut
  75
  76 sub ID {
  77   my ($self) = @_;
  78   $self->throw_exception( "Can't call ID() as a class method" )
  79     unless ref $self;
  80   return undef unless $self->in_storage;
  81   return $self->_create_ID(map { $_ => $self->{_column_data}{$_} }
  82                              $self->primary_columns);
  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   my %cond;
 105   my $prefix = defined $alias ? $alias.'.' : '';
 106   $cond{$prefix.$_} = $self->get_column($_) for $self->primary_columns;
 107   return \%cond;
 108 }
 109
 110 1;
 111
 112 =head1 AUTHORS
 113
 114 Matt S. Trout <mst@shadowcatsystems.co.uk>
 115
 116 =head1 LICENSE
 117
 118 You may distribute this code under the same terms as Perl itself.
 119
 120 =cut
 121