lib/DBIx/Class/PK.pm

   1 package DBIx::Class::PK;
   2
   3 use strict;
   4 use warnings;
   5 use Tie::IxHash;
   6
   7 use base qw/DBIx::Class::Row/;
   8
   9 =head1 NAME
  10
  11 DBIx::Class::PK - Primary Key class
  12
  13 =head1 SYNOPSIS
  14
  15 =head1 DESCRIPTION
  16
  17 This class contains methods for handling primary keys and methods
  18 depending on them.
  19
  20 =head1 METHODS
  21
  22 =cut
  23
  24 sub _ident_cond {
  25   my ($class) = @_;
  26   return join(" AND ", map { "$_ = ?" } $class->primary_columns);
  27 }
  28
  29 sub _ident_values {
  30   my ($self) = @_;
  31   return (map { $self->{_column_data}{$_} } $self->primary_columns);
  32 }
  33
  34 =head2 discard_changes
  35
  36 Re-selects the row from the database, losing any changes that had
  37 been made.
  38
  39 =cut
  40
  41 sub discard_changes {
  42   my ($self) = @_;
  43   delete $self->{_dirty_columns};
  44   return unless $self->in_storage; # Don't reload if we aren't real!
  45   my ($reload) = $self->find(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( "Can't call id() as a class method" ) unless ref $self;
  65   my @pk = $self->_ident_values;
  66   return (wantarray ? @pk : $pk[0]);
  67 }
  68
  69 =head2 ID
  70
  71 Returns a unique id string identifying a row object by primary key.
  72 Used by L<DBIx::Class::CDBICompat::LiveObjectIndex> and
  73 L<DBIx::Class::ObjectCache>.
  74
  75 =cut
  76
  77 sub ID {
  78   my ($self) = @_;
  79   $self->throw( "Can't call ID() as a class method" ) unless ref $self;
  80   return undef unless $self->in_storage;
  81   return $self->_create_ID(map { $_ => $self->{_column_data}{$_} } $self->primary_columns);
  82 }
  83
  84 sub _create_ID {
  85   my ($class,%vals) = @_;
  86   return undef unless 0 == grep { !defined } values %vals;
  87   $class = ref $class || $class;
  88   return join '|', $class, map { $_ . '=' . $vals{$_} } sort keys %vals;
  89 }
  90
  91 sub ident_condition {
  92   my ($self, $alias) = @_;
  93   my %cond;
  94   $cond{(defined $alias ? "${alias}.$_" : $_)} = $self->get_column($_) for $self->primary_columns;
  95   return \%cond;
  96 }
  97
  98 1;
  99
 100 =head1 AUTHORS
 101
 102 Matt S. Trout <mst@shadowcatsystems.co.uk>
 103
 104 =head1 LICENSE
 105
 106 You may distribute this code under the same terms as Perl itself.
 107
 108 =cut
 109