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