Profile: /wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/PK.pm

File	/wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/PK.pm
Statements Executed	10
Total Time	0.000535 seconds

Subroutines — ordered by exclusive time
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
0	0	0	0	0	DBIx::Class::PK::	BEGIN
0	0	0	0	0	DBIx::Class::PK::	ID
0	0	0	0	0	DBIx::Class::PK::	_create_ID
0	0	0	0	0	DBIx::Class::PK::	_ident_values
0	0	0	0	0	DBIx::Class::PK::	discard_changes
0	0	0	0	0	DBIx::Class::PK::	id
0	0	0	0	0	DBIx::Class::PK::	ident_condition

Line	Stmts.	Exclusive Time	Avg.	Code
1				package DBIx::Class::PK;
2
3	3	4.6e-5	1.5e-5	use strict; # spent 11µs making 1 call to strict::import
4	3	3.0e-5	1.0e-5	use warnings; # spent 22µs making 1 call to warnings::import
5
6	3	0.00046	0.00015	use base qw/DBIx::Class::Row/; # spent 72µs making 1 call to base::import
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	3.0e-6	3.0e-6	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