Commit | Line | Data |
---|---|---|
dbd7896f | 1 | package DBIx::Class::PK; |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | ||
1edd1722 | 6 | use base qw/DBIx::Class::Row/; |
dbd7896f | 7 | |
75d07914 | 8 | =head1 NAME |
34d52be2 | 9 | |
10 | DBIx::Class::PK - Primary Key class | |
11 | ||
12 | =head1 SYNOPSIS | |
13 | ||
14 | =head1 DESCRIPTION | |
15 | ||
75d07914 | 16 | This class contains methods for handling primary keys and methods |
8091aa91 | 17 | depending on them. |
34d52be2 | 18 | |
19 | =head1 METHODS | |
20 | ||
34d52be2 | 21 | =cut |
22 | ||
8091aa91 | 23 | =head2 id |
076652e8 | 24 | |
8091aa91 | 25 | Returns the primary key(s) for a row. Can't be called as |
076652e8 | 26 | a class method. |
27 | ||
28 | =cut | |
29 | ||
604d9f38 | 30 | sub id { |
31 | my ($self) = @_; | |
bc0c9800 | 32 | $self->throw_exception( "Can't call id() as a class method" ) |
33 | unless ref $self; | |
604d9f38 | 34 | my @pk = $self->_ident_values; |
35 | return (wantarray ? @pk : $pk[0]); | |
36 | } | |
37 | ||
bbd107cf | 38 | sub _ident_values { |
39 | my ($self) = @_; | |
40 | return (map { $self->{_column_data}{$_} } $self->primary_columns); | |
41 | } | |
42 | ||
8091aa91 | 43 | =head2 ID |
44 | ||
45 | Returns a unique id string identifying a row object by primary key. | |
75d07914 | 46 | Used by L<DBIx::Class::CDBICompat::LiveObjectIndex> and |
8091aa91 | 47 | L<DBIx::Class::ObjectCache>. |
48 | ||
bbd107cf | 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 | ||
8091aa91 | 60 | =cut |
61 | ||
48700d09 | 62 | sub ID { |
63 | my ($self) = @_; | |
bc0c9800 | 64 | $self->throw_exception( "Can't call ID() as a class method" ) |
65 | unless ref $self; | |
48700d09 | 66 | return undef unless $self->in_storage; |
bc0c9800 | 67 | return $self->_create_ID(map { $_ => $self->{_column_data}{$_} } |
68 | $self->primary_columns); | |
48700d09 | 69 | } |
70 | ||
71 | sub _create_ID { | |
9bbd8963 | 72 | my ($self,%vals) = @_; |
90f3f5ff | 73 | return undef unless 0 == grep { !defined } values %vals; |
bc0c9800 | 74 | return join '|', ref $self || $self, $self->result_source->name, |
75d07914 | 75 | map { $_ . '=' . $vals{$_} } sort keys %vals; |
48700d09 | 76 | } |
77 | ||
9b83fccd | 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 | ||
103647d5 | 88 | sub ident_condition { |
fea3d045 | 89 | my ($self, $alias) = @_; |
103647d5 | 90 | my %cond; |
e04df8ec | 91 | my $prefix = defined $alias ? $alias.'.' : ''; |
92 | $cond{$prefix.$_} = $self->get_column($_) for $self->primary_columns; | |
103647d5 | 93 | return \%cond; |
94 | } | |
95 | ||
dbd7896f | 96 | 1; |
34d52be2 | 97 | |
34d52be2 | 98 | =head1 AUTHORS |
99 | ||
daec44b8 | 100 | Matt S. Trout <mst@shadowcatsystems.co.uk> |
34d52be2 | 101 | |
102 | =head1 LICENSE | |
103 | ||
104 | You may distribute this code under the same terms as Perl itself. | |
105 | ||
106 | =cut | |
107 |