Unqualify imported functions
[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 @id_vals = $self->_ident_values;
35   return (wantarray ? @id_vals : $id_vals[0]);
36 }
37
38 sub _ident_values {
39   my ($self) = @_;
40
41   my (@ids, @missing);
42
43   for ($self->_pri_cols) {
44     push @ids, $self->get_column($_);
45     push @missing, $_ if (! defined $ids[-1] and ! $self->has_column_loaded ($_) );
46   }
47
48   if (@missing && $self->in_storage) {
49     $self->throw_exception (
50       'Unable to uniquely identify row object with missing PK columns: '
51       . join (', ', @missing )
52     );
53   }
54
55   return @ids;
56 }
57
58 =head2 ID
59
60 Returns a unique id string identifying a row object by primary key.
61 Used by L<DBIx::Class::CDBICompat::LiveObjectIndex> and
62 L<DBIx::Class::ObjectCache>.
63
64 =over
65
66 =item WARNING
67
68 The default C<_create_ID> method used by this function orders the returned
69 values by the alphabetical order of the primary column names, B<unlike>
70 the L</id> method, which follows the same order in which columns were fed
71 to L<DBIx::Class::ResultSource/set_primary_key>.
72
73 =back
74
75 =cut
76
77 sub ID {
78   my ($self) = @_;
79   $self->throw_exception( "Can't call ID() as a class method" )
80     unless ref $self;
81   return undef unless $self->in_storage;
82   return $self->_create_ID(%{$self->ident_condition});
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
105   my @pks = $self->_pri_cols;
106   my @vals = $self->_ident_values;
107
108   my (%cond, @undef);
109   my $prefix = defined $alias ? $alias.'.' : '';
110   for my $col (@pks) {
111     if (! defined ($cond{$prefix.$col} = shift @vals) ) {
112       push @undef, $col;
113     }
114   }
115
116   if (@undef && $self->in_storage) {
117     $self->throw_exception (
118       'Unable to construct row object identity condition due to NULL PK columns: '
119       . join (', ', @undef)
120     );
121   }
122
123   return \%cond;
124 }
125
126 1;
127
128 =head1 AUTHORS
129
130 Matt S. Trout <mst@shadowcatsystems.co.uk>
131
132 =head1 LICENSE
133
134 You may distribute this code under the same terms as Perl itself.
135
136 =cut
137