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