explained a cryptic error message
[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
33=cut
34
510ca912 35sub discard_changes {
36 my ($self) = @_;
37 delete $self->{_dirty_columns};
8d5134b0 38 return unless $self->in_storage; # Don't reload if we aren't real!
bc0c9800 39 my ($reload) = $self->result_source->resultset->find
40 (map { $self->$_ } $self->primary_columns);
c1d23573 41 unless ($reload) { # If we got deleted in the mean-time
8d5134b0 42 $self->in_storage(0);
c1d23573 43 return $self;
44 }
4a07648a 45 delete @{$self}{keys %$self};
46 @{$self}{keys %$reload} = values %$reload;
c1d23573 47 return $self;
510ca912 48}
49
8091aa91 50=head2 id
076652e8 51
8091aa91 52Returns the primary key(s) for a row. Can't be called as
076652e8 53a class method.
54
55=cut
56
604d9f38 57sub id {
58 my ($self) = @_;
bc0c9800 59 $self->throw_exception( "Can't call id() as a class method" )
60 unless ref $self;
604d9f38 61 my @pk = $self->_ident_values;
62 return (wantarray ? @pk : $pk[0]);
63}
64
8091aa91 65=head2 ID
66
67Returns a unique id string identifying a row object by primary key.
75d07914 68Used by L<DBIx::Class::CDBICompat::LiveObjectIndex> and
8091aa91 69L<DBIx::Class::ObjectCache>.
70
71=cut
72
48700d09 73sub ID {
74 my ($self) = @_;
bc0c9800 75 $self->throw_exception( "Can't call ID() as a class method" )
76 unless ref $self;
48700d09 77 return undef unless $self->in_storage;
bc0c9800 78 return $self->_create_ID(map { $_ => $self->{_column_data}{$_} }
79 $self->primary_columns);
48700d09 80}
81
82sub _create_ID {
9bbd8963 83 my ($self,%vals) = @_;
90f3f5ff 84 return undef unless 0 == grep { !defined } values %vals;
bc0c9800 85 return join '|', ref $self || $self, $self->result_source->name,
75d07914 86 map { $_ . '=' . $vals{$_} } sort keys %vals;
48700d09 87}
88
9b83fccd 89=head2 ident_condition
90
91 my $cond = $result_source->ident_condition();
92
93 my $cond = $result_source->ident_condition('alias');
94
95Produces a condition hash to locate a row based on the primary key(s).
96
97=cut
98
103647d5 99sub ident_condition {
fea3d045 100 my ($self, $alias) = @_;
103647d5 101 my %cond;
e04df8ec 102 my $prefix = defined $alias ? $alias.'.' : '';
103 $cond{$prefix.$_} = $self->get_column($_) for $self->primary_columns;
103647d5 104 return \%cond;
105}
106
dbd7896f 1071;
34d52be2 108
34d52be2 109=head1 AUTHORS
110
daec44b8 111Matt S. Trout <mst@shadowcatsystems.co.uk>
34d52be2 112
113=head1 LICENSE
114
115You may distribute this code under the same terms as Perl itself.
116
117=cut
118