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