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 ($attrs)
  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 $attrs is expected to be a hashref of attributes suitable for passing as the
  37 second argument to $resultset->search($cond, $attrs);
  38
  39 =cut
  40
  41 sub discard_changes {
  42   my ($self, $attrs) = @_;
  43   delete $self->{_dirty_columns};
  44   return unless $self->in_storage; # Don't reload if we aren't real!
  45
  46   $attrs = { force_pool => 'master', %{ defined $attrs ? $attrs:{} } };
  47   if( my $current_storage = $self->get_from_storage($attrs)) {
  48
  49     # Set $self to the current.
  50         %$self = %$current_storage;
  51
  52     # Avoid a possible infinite loop with
  53     # sub DESTROY { $_[0]->discard_changes }
  54     bless $current_storage, 'Do::Not::Exist';
  55
  56     return $self;
  57   } else {
  58     $self->in_storage(0);
  59     return $self;
  60   }
  61 }
  62
  63 =head2 id
  64
  65 Returns the primary key(s) for a row. Can't be called as
  66 a class method.
  67
  68 =cut
  69
  70 sub id {
  71   my ($self) = @_;
  72   $self->throw_exception( "Can't call id() as a class method" )
  73     unless ref $self;
  74   my @pk = $self->_ident_values;
  75   return (wantarray ? @pk : $pk[0]);
  76 }
  77
  78 =head2 ID
  79
  80 Returns a unique id string identifying a row object by primary key.
  81 Used by L<DBIx::Class::CDBICompat::LiveObjectIndex> and
  82 L<DBIx::Class::ObjectCache>.
  83
  84 =cut
  85
  86 sub ID {
  87   my ($self) = @_;
  88   $self->throw_exception( "Can't call ID() as a class method" )
  89     unless ref $self;
  90   return undef unless $self->in_storage;
  91   return $self->_create_ID(map { $_ => $self->{_column_data}{$_} }
  92                              $self->primary_columns);
  93 }
  94
  95 sub _create_ID {
  96   my ($self,%vals) = @_;
  97   return undef unless 0 == grep { !defined } values %vals;
  98   return join '|', ref $self || $self, $self->result_source->name,
  99     map { $_ . '=' . $vals{$_} } sort keys %vals;
 100 }
 101
 102 =head2 ident_condition
 103
 104   my $cond = $result_source->ident_condition();
 105
 106   my $cond = $result_source->ident_condition('alias');
 107
 108 Produces a condition hash to locate a row based on the primary key(s).
 109
 110 =cut
 111
 112 sub ident_condition {
 113   my ($self, $alias) = @_;
 114   my %cond;
 115   my $prefix = defined $alias ? $alias.'.' : '';
 116   $cond{$prefix.$_} = $self->get_column($_) for $self->primary_columns;
 117   return \%cond;
 118 }
 119
 120 1;
 121
 122 =head1 AUTHORS
 123
 124 Matt S. Trout <mst@shadowcatsystems.co.uk>
 125
 126 =head1 LICENSE
 127
 128 You may distribute this code under the same terms as Perl itself.
 129
 130 =cut
 131