make _determine_driver more reentrant
[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 =head2 id
24
25 Returns the primary key(s) for a row. Can't be called as
26 a class method.
27
28 =cut
29
30 sub id {
31   my ($self) = @_;
32   $self->throw_exception( "Can't call id() as a class method" )
33     unless ref $self;
34   my @pk = $self->_ident_values;
35   return (wantarray ? @pk : $pk[0]);
36 }
37
38 sub _ident_values {
39   my ($self) = @_;
40   return (map { $self->{_column_data}{$_} } $self->primary_columns);
41 }
42
43 =head2 ID
44
45 Returns a unique id string identifying a row object by primary key.
46 Used by L<DBIx::Class::CDBICompat::LiveObjectIndex> and
47 L<DBIx::Class::ObjectCache>.
48
49 =over
50
51 =item WARNING
52
53 The default C<_create_ID> method used by this function orders the returned
54 values by the alphabetical order of the primary column names, B<unlike>
55 the L</id> method, which follows the same order in which columns were fed
56 to L<DBIx::Class::ResultSource/set_primary_key>.
57
58 =back
59
60 =cut
61
62 sub ID {
63   my ($self) = @_;
64   $self->throw_exception( "Can't call ID() as a class method" )
65     unless ref $self;
66   return undef unless $self->in_storage;
67   return $self->_create_ID(map { $_ => $self->{_column_data}{$_} }
68                              $self->primary_columns);
69 }
70
71 sub _create_ID {
72   my ($self,%vals) = @_;
73   return undef unless 0 == grep { !defined } values %vals;
74   return join '|', ref $self || $self, $self->result_source->name,
75     map { $_ . '=' . $vals{$_} } sort keys %vals;
76 }
77
78 =head2 ident_condition
79
80   my $cond = $result_source->ident_condition();
81
82   my $cond = $result_source->ident_condition('alias');
83
84 Produces a condition hash to locate a row based on the primary key(s).
85
86 =cut
87
88 sub ident_condition {
89   my ($self, $alias) = @_;
90   my %cond;
91   my $prefix = defined $alias ? $alias.'.' : '';
92   $cond{$prefix.$_} = $self->get_column($_) for $self->primary_columns;
93   return \%cond;
94 }
95
96 1;
97
98 =head1 AUTHORS
99
100 Matt S. Trout <mst@shadowcatsystems.co.uk>
101
102 =head1 LICENSE
103
104 You may distribute this code under the same terms as Perl itself.
105
106 =cut
107