Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/DBIx/Class/DynamicDefault.pm |
Statements | Executed 280 statements in 652µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
4 | 1 | 1 | 218µs | 8.67ms | add_columns | DBIx::Class::DynamicDefault::
1 | 1 | 1 | 14µs | 16µs | BEGIN@1 | Class::C3::Componentised::
1 | 1 | 1 | 8µs | 16µs | BEGIN@2 | Class::C3::Componentised::
1 | 1 | 1 | 6µs | 61µs | BEGIN@6 | DBIx::Class::DynamicDefault::
4 | 1 | 1 | 6µs | 6µs | CORE:sort (opcode) | DBIx::Class::DynamicDefault::
0 | 0 | 0 | 0s | 0s | insert | DBIx::Class::DynamicDefault::
0 | 0 | 0 | 0s | 0s | update | DBIx::Class::DynamicDefault::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | 3 | 60µs | 2 | 19µs | # spent 16µs (14+2) within Class::C3::Componentised::BEGIN@1 which was called:
# once (14µs+2µs) by Class::C3::Componentised::ensure_class_loaded at line 1 # spent 16µs making 1 call to Class::C3::Componentised::BEGIN@1
# spent 2µs making 1 call to strict::import |
2 | 3 | 25µs | 2 | 24µs | # spent 16µs (8+8) within Class::C3::Componentised::BEGIN@2 which was called:
# once (8µs+8µs) by Class::C3::Componentised::ensure_class_loaded at line 2 # spent 16µs making 1 call to Class::C3::Componentised::BEGIN@2
# spent 8µs making 1 call to warnings::import |
3 | |||||
4 | package DBIx::Class::DynamicDefault; | ||||
5 | |||||
6 | 3 | 346µs | 2 | 115µs | # spent 61µs (6+54) within DBIx::Class::DynamicDefault::BEGIN@6 which was called:
# once (6µs+54µs) by Class::C3::Componentised::ensure_class_loaded at line 6 # spent 61µs making 1 call to DBIx::Class::DynamicDefault::BEGIN@6
# spent 54µs making 1 call to base::import |
7 | |||||
8 | 1 | 600ns | our $VERSION = '0.04'; | ||
9 | |||||
10 | 1 | 13µs | $VERSION = eval $VERSION; # spent 2µs executing statements in string eval | ||
11 | |||||
12 | 1 | 6µs | 1 | 287µs | __PACKAGE__->mk_classdata( # spent 287µs making 1 call to DBIx::Class::mk_classdata |
13 | __column_dynamic_default_triggers => { | ||||
14 | on_update => [], on_create => [], | ||||
15 | }, | ||||
16 | ); | ||||
17 | |||||
18 | =head1 NAME | ||||
19 | |||||
20 | DBIx::Class::DynamicDefault - Automatically set and update fields | ||||
21 | |||||
22 | =head1 SYNOPSIS | ||||
23 | |||||
24 | package My::Schema::SomeTable; | ||||
25 | |||||
26 | __PACKAGE__->load_components(qw/DynamicDefault ... Core/); | ||||
27 | |||||
28 | __PACKAGE__->add_columns( | ||||
29 | quux => { data_type => 'integer' }, | ||||
30 | quux_plus_one => { data_type => 'integer', | ||||
31 | dynamic_default_on_create => \&quux_plus_one_default, | ||||
32 | dynamic_default_on_update => 'quux_plus_one_default', }, | ||||
33 | last_changed => { data_type => 'integer', | ||||
34 | dynamic_default_on_create => 'now', | ||||
35 | dynamic_default_on_update => 'now, }, | ||||
36 | ); | ||||
37 | |||||
38 | sub quux_plus_one_default { | ||||
39 | my ($self) = @_; | ||||
40 | return $self->quux + 1; | ||||
41 | } | ||||
42 | |||||
43 | sub now { | ||||
44 | return DateTime->now->epoch; | ||||
45 | } | ||||
46 | |||||
47 | Now, any update or create actions will set the specified columns to the value | ||||
48 | returned by the callback you specified as a method name or code reference. | ||||
49 | |||||
50 | =head1 DESCRIPTION | ||||
51 | |||||
52 | Automatically set and update fields with values calculated at runtime. | ||||
53 | |||||
54 | =cut | ||||
55 | |||||
56 | # spent 8.67ms (218µs+8.45) within DBIx::Class::DynamicDefault::add_columns which was called 4 times, avg 2.17ms/call:
# 4 times (218µs+8.45ms) by DBIx::Class::TimeStamp::add_columns at line 28 of mro.pm, avg 2.17ms/call | ||||
57 | 32 | 129µs | my $self = shift; | ||
58 | |||||
59 | 4 | 70µs | $self->next::method(@_); # spent 70µs making 4 calls to next::method, avg 18µs/call | ||
60 | |||||
61 | my @update_columns; | ||||
62 | my @create_columns; | ||||
63 | |||||
64 | 4 | 40µs | my $source = $self->result_source_instance; # spent 10µs making 1 call to Tapper::Schema::ReportsDB::Result::Report::result_source_instance
# spent 10µs making 1 call to Tapper::Schema::ReportsDB::Result::Tap::result_source_instance
# spent 10µs making 1 call to Tapper::Schema::ReportsDB::Result::ReportComment::result_source_instance
# spent 10µs making 1 call to Tapper::Schema::ReportsDB::Result::ReportFile::result_source_instance | ||
65 | |||||
66 | 4 | 115µs | my $col_info = $source->columns_info; # spent 115µs making 4 calls to DBIx::Class::ResultSource::columns_info, avg 29µs/call | ||
67 | |||||
68 | for my $column (keys %$col_info) { | ||||
69 | 235 | 68µs | my $info = $col_info->{$column}; | ||
70 | |||||
71 | my $update_trigger = $info->{dynamic_default_on_update}; | ||||
72 | push @update_columns, [$column => $update_trigger, $info->{always_update} || 0] | ||||
73 | if $update_trigger; | ||||
74 | |||||
75 | my $create_trigger = $info->{dynamic_default_on_create}; | ||||
76 | push @create_columns, [$column => $create_trigger] | ||||
77 | if $create_trigger; | ||||
78 | } | ||||
79 | |||||
80 | 8 | 62µs | if (@update_columns || @create_columns) { # spent 56µs making 4 calls to DBIx::Class::DynamicDefault::__column_dynamic_default_triggers, avg 14µs/call
# spent 6µs making 4 calls to DBIx::Class::DynamicDefault::CORE:sort, avg 2µs/call | ||
81 | $self->__column_dynamic_default_triggers({ | ||||
82 | on_update => [sort { $b->[2] <=> $a->[2] } @update_columns], | ||||
83 | on_create => \@create_columns, | ||||
84 | }); | ||||
85 | } | ||||
86 | } | ||||
87 | |||||
88 | sub insert { | ||||
89 | my $self = shift; | ||||
90 | |||||
91 | my @columns = @{ $self->__column_dynamic_default_triggers->{on_create} }; | ||||
92 | for my $column (@columns) { | ||||
93 | my $column_name = $column->[0]; | ||||
94 | next if defined $self->get_column($column_name); | ||||
95 | |||||
96 | my $meth = $column->[1]; | ||||
97 | my $default_value = $self->$meth; | ||||
98 | |||||
99 | my $accessor = $self->column_info($column_name)->{accessor} || $column_name; | ||||
100 | $self->$accessor($default_value); | ||||
101 | } | ||||
102 | |||||
103 | return $self->next::method(@_); | ||||
104 | } | ||||
105 | |||||
106 | sub update { | ||||
107 | my ($self, $upd) = @_; | ||||
108 | |||||
109 | $self->set_inflated_columns($upd) if $upd; | ||||
110 | my %dirty = $self->get_dirty_columns; | ||||
111 | |||||
112 | my @columns = @{ $self->__column_dynamic_default_triggers->{on_update} }; | ||||
113 | for my $column (@columns) { | ||||
114 | my $column_name = $column->[0]; | ||||
115 | next if !%dirty && !$column->[2]; | ||||
116 | next if exists $dirty{$column_name}; | ||||
117 | |||||
118 | my $meth = $column->[1]; | ||||
119 | my $default_value = $self->$meth; | ||||
120 | |||||
121 | my $accessor = $self->column_info($column_name)->{accessor} || $column_name; | ||||
122 | $self->$accessor($default_value); | ||||
123 | |||||
124 | $dirty{$column_name} = 1; | ||||
125 | } | ||||
126 | |||||
127 | return $self->next::method; | ||||
128 | } | ||||
129 | |||||
130 | =head1 OPTIONS | ||||
131 | |||||
132 | =head2 dynamic_default_on_create | ||||
133 | |||||
134 | dynamic_default_on_create => sub { ... } | ||||
135 | |||||
136 | dynamic_default_on_create => 'method_name' | ||||
137 | |||||
138 | When inserting a new row all columns with the C<dynamic_default_on_create> | ||||
139 | option will be set to the return value of the specified callback unless the | ||||
140 | columns value has been explicitly set. The callback, that'll be invoked with | ||||
141 | the row object as its only argument, may be a code reference or a method name. | ||||
142 | |||||
143 | =head2 dynamic_default_on_update | ||||
144 | |||||
145 | dynamic_default_on_update => sub { ... } | ||||
146 | |||||
147 | dynamic_default_on_update => 'method_name' | ||||
148 | |||||
149 | When updating a row all columns with the C<dynamic_default_on_update> option | ||||
150 | will be set to the return value of the specified callback unless the columns | ||||
151 | value has been explicitly set. | ||||
152 | |||||
153 | Columns will only be altered if other dirty columns exist. See C<always_update> | ||||
154 | on how to change this. | ||||
155 | |||||
156 | =head2 always_update | ||||
157 | |||||
158 | always_update => 1 | ||||
159 | |||||
160 | When setting C<always_update> to 1 C<dynamic_default_on_update> callbacks will | ||||
161 | always be invoked, even if no other columns are dirty. | ||||
162 | |||||
163 | =head1 AUTHOR | ||||
164 | |||||
165 | Florian Ragwitz E<lt>rafl@debian.orgE<gt> | ||||
166 | |||||
167 | =head1 LICENSE | ||||
168 | |||||
169 | This software is copyright (c) 2008 by Florian Ragwitz. | ||||
170 | |||||
171 | This is free software; you can redistribute it and/or modify it under | ||||
172 | the same terms as perl itself. | ||||
173 | |||||
174 | =cut | ||||
175 | |||||
176 | 1 | 4µs | 1; | ||
# spent 6µs within DBIx::Class::DynamicDefault::CORE:sort which was called 4 times, avg 2µs/call:
# 4 times (6µs+0s) by DBIx::Class::DynamicDefault::add_columns at line 80, avg 2µs/call |