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 sub ident_condition {
  95   my ($self, $alias) = @_;
  96   my %cond;
  97   $cond{(defined $alias ? "${alias}.$_" : $_)} = $self->get_column($_)
  98     for $self->primary_columns;
  99   return \%cond;
 100 }
 101
 102 1;
 103
 104 =head1 AUTHORS
 105
 106 Matt S. Trout <mst@shadowcatsystems.co.uk>
 107
 108 =head1 LICENSE
 109
 110 You may distribute this code under the same terms as Perl itself.
 111
 112 =cut
 113