Applied patch from kados regarding use of a DateTime::Format class to validate
[dbsrgits/DBIx-Class-Historic.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_values {
24   my ($self) = @_;
25   return (map { $self->{_column_data}{$_} } $self->primary_columns);
26 }
27
28 =head2 discard_changes ($attrs)
29
30 Re-selects the row from the database, losing any changes that had
31 been made.
32
33 This method can also be used to refresh from storage, retrieving any
34 changes made since the row was last read from storage.
35
36 $attrs is expected to be a hashref of attributes suitable for passing as the
37 second argument to $resultset->search($cond, $attrs);
38
39 =cut
40
41 sub discard_changes {
42   my ($self, $attrs) = @_;
43   delete $self->{_dirty_columns};
44   return unless $self->in_storage; # Don't reload if we aren't real!
45   
46   if( my $current_storage = $self->get_from_storage($attrs)) {
47         
48     # Set $self to the current.
49         %$self = %$current_storage;
50         
51     # Avoid a possible infinite loop with
52     # sub DESTROY { $_[0]->discard_changes }
53     bless $current_storage, 'Do::Not::Exist';
54     
55     return $self;       
56   } else {
57     $self->in_storage(0);
58     return $self;       
59   }
60 }
61
62 =head2 id
63
64 Returns the primary key(s) for a row. Can't be called as
65 a class method.
66
67 =cut
68
69 sub id {
70   my ($self) = @_;
71   $self->throw_exception( "Can't call id() as a class method" )
72     unless ref $self;
73   my @pk = $self->_ident_values;
74   return (wantarray ? @pk : $pk[0]);
75 }
76
77 =head2 ID
78
79 Returns a unique id string identifying a row object by primary key.
80 Used by L<DBIx::Class::CDBICompat::LiveObjectIndex> and
81 L<DBIx::Class::ObjectCache>.
82
83 =cut
84
85 sub ID {
86   my ($self) = @_;
87   $self->throw_exception( "Can't call ID() as a class method" )
88     unless ref $self;
89   return undef unless $self->in_storage;
90   return $self->_create_ID(map { $_ => $self->{_column_data}{$_} }
91                              $self->primary_columns);
92 }
93
94 sub _create_ID {
95   my ($self,%vals) = @_;
96   return undef unless 0 == grep { !defined } values %vals;
97   return join '|', ref $self || $self, $self->result_source->name,
98     map { $_ . '=' . $vals{$_} } sort keys %vals;
99 }
100
101 =head2 ident_condition
102
103   my $cond = $result_source->ident_condition();
104
105   my $cond = $result_source->ident_condition('alias');
106
107 Produces a condition hash to locate a row based on the primary key(s).
108
109 =cut
110
111 sub ident_condition {
112   my ($self, $alias) = @_;
113   my %cond;
114   my $prefix = defined $alias ? $alias.'.' : '';
115   $cond{$prefix.$_} = $self->get_column($_) for $self->primary_columns;
116   return \%cond;
117 }
118
119 1;
120
121 =head1 AUTHORS
122
123 Matt S. Trout <mst@shadowcatsystems.co.uk>
124
125 =head1 LICENSE
126
127 You may distribute this code under the same terms as Perl itself.
128
129 =cut
130