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