Updated version and Changes for 0.06999_02
[dbsrgits/DBIx-Class.git] / 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