Reduce the number of times $self->_dbh is called inside dbh_do() to speed
[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 This method can also be used to refresh from storage, retrieving any
34 changes made since the row was last read from storage.
35
36 =cut
37
38 sub discard_changes {
39   my ($self) = @_;
40   delete $self->{_dirty_columns};
41   return unless $self->in_storage; # Don't reload if we aren't real!
42
43   my $reload = $self->result_source->resultset->find(
44     map { $self->$_ } $self->primary_columns
45   );
46   unless ($reload) { # If we got deleted in the mean-time
47     $self->in_storage(0);
48     return $self;
49   }
50
51   %$self = %$reload;
52   
53   # Avoid a possible infinite loop with
54   # sub DESTROY { $_[0]->discard_changes }
55   bless $reload, 'Do::Not::Exist';
56
57   return $self;
58 }
59
60 =head2 id
61
62 Returns the primary key(s) for a row. Can't be called as
63 a class method.
64
65 =cut
66
67 sub id {
68   my ($self) = @_;
69   $self->throw_exception( "Can't call id() as a class method" )
70     unless ref $self;
71   my @pk = $self->_ident_values;
72   return (wantarray ? @pk : $pk[0]);
73 }
74
75 =head2 ID
76
77 Returns a unique id string identifying a row object by primary key.
78 Used by L<DBIx::Class::CDBICompat::LiveObjectIndex> and
79 L<DBIx::Class::ObjectCache>.
80
81 =cut
82
83 sub ID {
84   my ($self) = @_;
85   $self->throw_exception( "Can't call ID() as a class method" )
86     unless ref $self;
87   return undef unless $self->in_storage;
88   return $self->_create_ID(map { $_ => $self->{_column_data}{$_} }
89                              $self->primary_columns);
90 }
91
92 sub _create_ID {
93   my ($self,%vals) = @_;
94   return undef unless 0 == grep { !defined } values %vals;
95   return join '|', ref $self || $self, $self->result_source->name,
96     map { $_ . '=' . $vals{$_} } sort keys %vals;
97 }
98
99 =head2 ident_condition
100
101   my $cond = $result_source->ident_condition();
102
103   my $cond = $result_source->ident_condition('alias');
104
105 Produces a condition hash to locate a row based on the primary key(s).
106
107 =cut
108
109 sub ident_condition {
110   my ($self, $alias) = @_;
111   my %cond;
112   my $prefix = defined $alias ? $alias.'.' : '';
113   $cond{$prefix.$_} = $self->get_column($_) for $self->primary_columns;
114   return \%cond;
115 }
116
117 1;
118
119 =head1 AUTHORS
120
121 Matt S. Trout <mst@shadowcatsystems.co.uk>
122
123 =head1 LICENSE
124
125 You may distribute this code under the same terms as Perl itself.
126
127 =cut
128