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