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