ResultSetColumn::func() now returns all results if called in list context
[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
8091aa91 28=head2 discard_changes
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
076652e8 36=cut
37
510ca912 38sub discard_changes {
39 my ($self) = @_;
40 delete $self->{_dirty_columns};
8d5134b0 41 return unless $self->in_storage; # Don't reload if we aren't real!
bc0c9800 42 my ($reload) = $self->result_source->resultset->find
43 (map { $self->$_ } $self->primary_columns);
c1d23573 44 unless ($reload) { # If we got deleted in the mean-time
8d5134b0 45 $self->in_storage(0);
c1d23573 46 return $self;
47 }
4a07648a 48 delete @{$self}{keys %$self};
49 @{$self}{keys %$reload} = values %$reload;
c1d23573 50 return $self;
510ca912 51}
52
8091aa91 53=head2 id
076652e8 54
8091aa91 55Returns the primary key(s) for a row. Can't be called as
076652e8 56a class method.
57
58=cut
59
604d9f38 60sub id {
61 my ($self) = @_;
bc0c9800 62 $self->throw_exception( "Can't call id() as a class method" )
63 unless ref $self;
604d9f38 64 my @pk = $self->_ident_values;
65 return (wantarray ? @pk : $pk[0]);
66}
67
8091aa91 68=head2 ID
69
70Returns a unique id string identifying a row object by primary key.
75d07914 71Used by L<DBIx::Class::CDBICompat::LiveObjectIndex> and
8091aa91 72L<DBIx::Class::ObjectCache>.
73
74=cut
75
48700d09 76sub ID {
77 my ($self) = @_;
bc0c9800 78 $self->throw_exception( "Can't call ID() as a class method" )
79 unless ref $self;
48700d09 80 return undef unless $self->in_storage;
bc0c9800 81 return $self->_create_ID(map { $_ => $self->{_column_data}{$_} }
82 $self->primary_columns);
48700d09 83}
84
85sub _create_ID {
9bbd8963 86 my ($self,%vals) = @_;
90f3f5ff 87 return undef unless 0 == grep { !defined } values %vals;
bc0c9800 88 return join '|', ref $self || $self, $self->result_source->name,
75d07914 89 map { $_ . '=' . $vals{$_} } sort keys %vals;
48700d09 90}
91
9b83fccd 92=head2 ident_condition
93
94 my $cond = $result_source->ident_condition();
95
96 my $cond = $result_source->ident_condition('alias');
97
98Produces a condition hash to locate a row based on the primary key(s).
99
100=cut
101
103647d5 102sub ident_condition {
fea3d045 103 my ($self, $alias) = @_;
103647d5 104 my %cond;
e04df8ec 105 my $prefix = defined $alias ? $alias.'.' : '';
106 $cond{$prefix.$_} = $self->get_column($_) for $self->primary_columns;
103647d5 107 return \%cond;
108}
109
dbd7896f 1101;
34d52be2 111
34d52be2 112=head1 AUTHORS
113
daec44b8 114Matt S. Trout <mst@shadowcatsystems.co.uk>
34d52be2 115
116=head1 LICENSE
117
118You may distribute this code under the same terms as Perl itself.
119
120=cut
121