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->find(map { $self->$_ } $self->primary_columns);
  45   unless ($reload) { # If we got deleted in the mean-time
  46     $self->in_storage(0);
  47     return $self;
  48   }
  49   delete @{$self}{keys %$self};
  50   @{$self}{keys %$reload} = values %$reload;
  51   return $self;
  52 }
  53
  54 =head2 id
  55
  56 Returns the primary key(s) for a row. Can't be called as
  57 a class method.
  58
  59 =cut
  60
  61 sub id {
  62   my ($self) = @_;
  63   $self->throw_exception( "Can't call id() as a class method" ) 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" ) unless ref $self;
  79   return undef unless $self->in_storage;
  80   return $self->_create_ID(map { $_ => $self->{_column_data}{$_} } $self->primary_columns);
  81 }
  82
  83 sub _create_ID {
  84   my ($self,%vals) = @_;
  85   return undef unless 0 == grep { !defined } values %vals;
  86   return join '|', ref $self || $self, $self->result_source->name, map { $_ . '=' . $vals{$_} } sort keys %vals;
  87 }
  88
  89 sub ident_condition {
  90   my ($self, $alias) = @_;
  91   my %cond;
  92   $cond{(defined $alias ? "${alias}.$_" : $_)} = $self->get_column($_) for $self->primary_columns;
  93   return \%cond;
  94 }
  95
  96 1;
  97
  98 =head1 AUTHORS
  99
 100 Matt S. Trout <mst@shadowcatsystems.co.uk>
 101
 102 =head1 LICENSE
 103
 104 You may distribute this code under the same terms as Perl itself.
 105
 106 =cut
 107