Fix the merge with txn_scope_guard() and put the necessary =cut in.
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / PK.pm
CommitLineData
dbd7896f 1package DBIx::Class::PK;
2
3use strict;
4use warnings;
5
1edd1722 6use base qw/DBIx::Class::Row/;
dbd7896f 7
75d07914 8=head1 NAME
34d52be2 9
10DBIx::Class::PK - Primary Key class
11
12=head1 SYNOPSIS
13
14=head1 DESCRIPTION
15
75d07914 16This class contains methods for handling primary keys and methods
8091aa91 17depending on them.
34d52be2 18
19=head1 METHODS
20
34d52be2 21=cut
22
dbd7896f 23sub _ident_values {
24 my ($self) = @_;
d7156e50 25 return (map { $self->{_column_data}{$_} } $self->primary_columns);
dbd7896f 26}
27
8091aa91 28=head2 discard_changes
076652e8 29
8091aa91 30Re-selects the row from the database, losing any changes that had
31been made.
076652e8 32
aefa6508 33This method can also be used to refresh from storage, retrieving any
34changes made since the row was last read from storage.
35
076652e8 36=cut
37
510ca912 38sub discard_changes {
39 my ($self) = @_;
40 delete $self->{_dirty_columns};
8d5134b0 41 return unless $self->in_storage; # Don't reload if we aren't real!
7e36a763 42
43 my $reload = $self->result_source->resultset->find(
44 map { $self->$_ } $self->primary_columns
45 );
c1d23573 46 unless ($reload) { # If we got deleted in the mean-time
8d5134b0 47 $self->in_storage(0);
c1d23573 48 return $self;
49 }
7e36a763 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
c1d23573 57 return $self;
510ca912 58}
59
8091aa91 60=head2 id
076652e8 61
8091aa91 62Returns the primary key(s) for a row. Can't be called as
076652e8 63a class method.
64
65=cut
66
604d9f38 67sub id {
68 my ($self) = @_;
bc0c9800 69 $self->throw_exception( "Can't call id() as a class method" )
70 unless ref $self;
604d9f38 71 my @pk = $self->_ident_values;
72 return (wantarray ? @pk : $pk[0]);
73}
74
8091aa91 75=head2 ID
76
77Returns a unique id string identifying a row object by primary key.
75d07914 78Used by L<DBIx::Class::CDBICompat::LiveObjectIndex> and
8091aa91 79L<DBIx::Class::ObjectCache>.
80
81=cut
82
48700d09 83sub ID {
84 my ($self) = @_;
bc0c9800 85 $self->throw_exception( "Can't call ID() as a class method" )
86 unless ref $self;
48700d09 87 return undef unless $self->in_storage;
bc0c9800 88 return $self->_create_ID(map { $_ => $self->{_column_data}{$_} }
89 $self->primary_columns);
48700d09 90}
91
92sub _create_ID {
9bbd8963 93 my ($self,%vals) = @_;
90f3f5ff 94 return undef unless 0 == grep { !defined } values %vals;
bc0c9800 95 return join '|', ref $self || $self, $self->result_source->name,
75d07914 96 map { $_ . '=' . $vals{$_} } sort keys %vals;
48700d09 97}
98
9b83fccd 99=head2 ident_condition
100
101 my $cond = $result_source->ident_condition();
102
103 my $cond = $result_source->ident_condition('alias');
104
105Produces a condition hash to locate a row based on the primary key(s).
106
107=cut
108
103647d5 109sub ident_condition {
fea3d045 110 my ($self, $alias) = @_;
103647d5 111 my %cond;
e04df8ec 112 my $prefix = defined $alias ? $alias.'.' : '';
113 $cond{$prefix.$_} = $self->get_column($_) for $self->primary_columns;
103647d5 114 return \%cond;
115}
116
dbd7896f 1171;
34d52be2 118
34d52be2 119=head1 AUTHORS
120
daec44b8 121Matt S. Trout <mst@shadowcatsystems.co.uk>
34d52be2 122
123=head1 LICENSE
124
125You may distribute this code under the same terms as Perl itself.
126
127=cut
128