add_relationship, relationship_info, relationships moved to ResultSource
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / PK.pm
CommitLineData
dbd7896f 1package DBIx::Class::PK;
2
3use strict;
4use warnings;
6eec7501 5use Tie::IxHash;
dbd7896f 6
1edd1722 7use base qw/DBIx::Class::Row/;
dbd7896f 8
34d52be2 9=head1 NAME
10
11DBIx::Class::PK - Primary Key class
12
13=head1 SYNOPSIS
14
15=head1 DESCRIPTION
16
8091aa91 17This class contains methods for handling primary keys and methods
18depending on them.
34d52be2 19
20=head1 METHODS
21
34d52be2 22=cut
23
dbd7896f 24sub _ident_cond {
25 my ($class) = @_;
d7156e50 26 return join(" AND ", map { "$_ = ?" } $class->primary_columns);
dbd7896f 27}
28
29sub _ident_values {
30 my ($self) = @_;
d7156e50 31 return (map { $self->{_column_data}{$_} } $self->primary_columns);
dbd7896f 32}
33
8091aa91 34=head2 discard_changes
076652e8 35
8091aa91 36Re-selects the row from the database, losing any changes that had
37been made.
076652e8 38
39=cut
40
510ca912 41sub discard_changes {
42 my ($self) = @_;
43 delete $self->{_dirty_columns};
8d5134b0 44 return unless $self->in_storage; # Don't reload if we aren't real!
741d6d0e 45 my ($reload) = $self->find(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) = @_;
78bab9ca 64 $self->throw( "Can't call id() as a class method" ) unless ref $self;
604d9f38 65 my @pk = $self->_ident_values;
66 return (wantarray ? @pk : $pk[0]);
67}
68
8091aa91 69=head2 ID
70
71Returns a unique id string identifying a row object by primary key.
72Used by L<DBIx::Class::CDBICompat::LiveObjectIndex> and
73L<DBIx::Class::ObjectCache>.
74
75=cut
76
48700d09 77sub ID {
78 my ($self) = @_;
79 $self->throw( "Can't call ID() as a class method" ) unless ref $self;
80 return undef unless $self->in_storage;
d7156e50 81 return $self->_create_ID(map { $_ => $self->{_column_data}{$_} } $self->primary_columns);
48700d09 82}
83
84sub _create_ID {
85 my ($class,%vals) = @_;
90f3f5ff 86 return undef unless 0 == grep { !defined } values %vals;
48700d09 87 $class = ref $class || $class;
88 return join '|', $class, map { $_ . '=' . $vals{$_} } sort keys %vals;
89}
90
103647d5 91sub ident_condition {
fea3d045 92 my ($self, $alias) = @_;
103647d5 93 my %cond;
fea3d045 94 $cond{(defined $alias ? "${alias}.$_" : $_)} = $self->get_column($_) for $self->primary_columns;
103647d5 95 return \%cond;
96}
97
dbd7896f 981;
34d52be2 99
34d52be2 100=head1 AUTHORS
101
daec44b8 102Matt S. Trout <mst@shadowcatsystems.co.uk>
34d52be2 103
104=head1 LICENSE
105
106You may distribute this code under the same terms as Perl itself.
107
108=cut
109