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