← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:50 2015

Filename/usr/share/perl5/DateTime/Span.pm
StatementsExecuted 19 statements in 1.94ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1113.75ms3.95msDateTime::Span::::BEGIN@10DateTime::Span::BEGIN@10
11111µs22µsDateTime::Span::::BEGIN@7DateTime::Span::BEGIN@7
1118µs44µsDateTime::Span::::BEGIN@12DateTime::Span::BEGIN@12
1117µs7µsDateTime::Span::::BEGIN@9DateTime::Span::BEGIN@9
1116µs23µsDateTime::Span::::BEGIN@13DateTime::Span::BEGIN@13
1116µs27µsDateTime::Span::::BEGIN@16DateTime::Span::BEGIN@16
1116µs30µsDateTime::Span::::BEGIN@15DateTime::Span::BEGIN@15
0000s0sDateTime::Span::::__ANON__[:28]DateTime::Span::__ANON__[:28]
0000s0sDateTime::Span::::cloneDateTime::Span::clone
0000s0sDateTime::Span::::complementDateTime::Span::complement
0000s0sDateTime::Span::::containsDateTime::Span::contains
0000s0sDateTime::Span::::durationDateTime::Span::duration
0000s0sDateTime::Span::::endDateTime::Span::end
0000s0sDateTime::Span::::end_is_closedDateTime::Span::end_is_closed
0000s0sDateTime::Span::::end_is_openDateTime::Span::end_is_open
0000s0sDateTime::Span::::from_datetime_and_durationDateTime::Span::from_datetime_and_duration
0000s0sDateTime::Span::::from_datetimesDateTime::Span::from_datetimes
0000s0sDateTime::Span::::intersectionDateTime::Span::intersection
0000s0sDateTime::Span::::intersectsDateTime::Span::intersects
0000s0sDateTime::Span::::is_empty_setDateTime::Span::is_empty_set
0000s0sDateTime::Span::::newDateTime::Span::new
0000s0sDateTime::Span::::set_time_zoneDateTime::Span::set_time_zone
0000s0sDateTime::Span::::spanDateTime::Span::span
0000s0sDateTime::Span::::startDateTime::Span::start
0000s0sDateTime::Span::::start_is_closedDateTime::Span::start_is_closed
0000s0sDateTime::Span::::start_is_openDateTime::Span::start_is_open
0000s0sDateTime::Span::::unionDateTime::Span::union
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# Copyright (c) 2003 Flavio Soibelmann Glock. All rights reserved.
2# This program is free software; you can redistribute it and/or
3# modify it under the same terms as Perl itself.
4
5package DateTime::Span;
6
7222µs232µs
# spent 22µs (11+10) within DateTime::Span::BEGIN@7 which was called: # once (11µs+10µs) by DateTime::Set::BEGIN@8 at line 7
use strict;
# spent 22µs making 1 call to DateTime::Span::BEGIN@7 # spent 10µs making 1 call to strict::import
8
9225µs17µs
# spent 7µs within DateTime::Span::BEGIN@9 which was called: # once (7µs+0s) by DateTime::Set::BEGIN@8 at line 9
use DateTime::Set;
# spent 7µs making 1 call to DateTime::Span::BEGIN@9
102700µs13.95ms
# spent 3.95ms (3.75+199µs) within DateTime::Span::BEGIN@10 which was called: # once (3.75ms+199µs) by DateTime::Set::BEGIN@8 at line 10
use DateTime::SpanSet;
# spent 3.95ms making 1 call to DateTime::Span::BEGIN@10
11
12224µs281µs
# spent 44µs (8+36) within DateTime::Span::BEGIN@12 which was called: # once (8µs+36µs) by DateTime::Set::BEGIN@8 at line 12
use Params::Validate qw( validate SCALAR BOOLEAN OBJECT CODEREF ARRAYREF );
# spent 44µs making 1 call to DateTime::Span::BEGIN@12 # spent 36µs making 1 call to Exporter::import
13225µs239µs
# spent 23µs (6+16) within DateTime::Span::BEGIN@13 which was called: # once (6µs+16µs) by DateTime::Set::BEGIN@8 at line 13
use vars qw( $VERSION );
# spent 23µs making 1 call to DateTime::Span::BEGIN@13 # spent 16µs making 1 call to vars::import
14
15224µs254µs
# spent 30µs (6+24) within DateTime::Span::BEGIN@15 which was called: # once (6µs+24µs) by DateTime::Set::BEGIN@8 at line 15
use constant INFINITY => DateTime::INFINITY;
# spent 30µs making 1 call to DateTime::Span::BEGIN@15 # spent 24µs making 1 call to constant::import
1621.11ms248µs
# spent 27µs (6+21) within DateTime::Span::BEGIN@16 which was called: # once (6µs+21µs) by DateTime::Set::BEGIN@8 at line 16
use constant NEG_INFINITY => DateTime::NEG_INFINITY;
# spent 27µs making 1 call to DateTime::Span::BEGIN@16 # spent 21µs making 1 call to constant::import
171200ns$VERSION = $DateTime::Set::VERSION;
18
19sub set_time_zone {
20 my ( $self, $tz ) = @_;
21
22 $self->{set} = $self->{set}->iterate(
23 sub {
24 my %tmp = %{ $_[0]->{list}[0] };
25 $tmp{a} = $tmp{a}->clone->set_time_zone( $tz ) if ref $tmp{a};
26 $tmp{b} = $tmp{b}->clone->set_time_zone( $tz ) if ref $tmp{b};
27 \%tmp;
28 }
29 );
30 return $self;
31}
32
33# note: the constructor must clone its DateTime parameters, such that
34# the set elements become immutable
35sub from_datetimes {
36 my $class = shift;
37 my %args = validate( @_,
38 { start =>
39 { type => OBJECT,
40 optional => 1,
41 },
42 end =>
43 { type => OBJECT,
44 optional => 1,
45 },
46 after =>
47 { type => OBJECT,
48 optional => 1,
49 },
50 before =>
51 { type => OBJECT,
52 optional => 1,
53 },
54 }
55 );
56 my $self = {};
57 my $set;
58
59 die "No arguments given to DateTime::Span->from_datetimes\n"
60 unless keys %args;
61
62 if ( exists $args{start} && exists $args{after} ) {
63 die "Cannot give both start and after arguments to DateTime::Span->from_datetimes\n";
64 }
65 if ( exists $args{end} && exists $args{before} ) {
66 die "Cannot give both end and before arguments to DateTime::Span->from_datetimes\n";
67 }
68
69 my ( $start, $open_start, $end, $open_end );
70 ( $start, $open_start ) = ( NEG_INFINITY, 0 );
71 ( $start, $open_start ) = ( $args{start}, 0 ) if exists $args{start};
72 ( $start, $open_start ) = ( $args{after}, 1 ) if exists $args{after};
73 ( $end, $open_end ) = ( INFINITY, 0 );
74 ( $end, $open_end ) = ( $args{end}, 0 ) if exists $args{end};
75 ( $end, $open_end ) = ( $args{before}, 1 ) if exists $args{before};
76
77 if ( $start > $end ) {
78 die "Span cannot start after the end in DateTime::Span->from_datetimes\n";
79 }
80 $set = Set::Infinite::_recurrence->new( $start, $end );
81 if ( $start != $end ) {
82 # remove start, such that we have ">" instead of ">="
83 $set = $set->complement( $start ) if $open_start;
84 # remove end, such that we have "<" instead of "<="
85 $set = $set->complement( $end ) if $open_end;
86 }
87
88 $self->{set} = $set;
89 bless $self, $class;
90 return $self;
91}
92
93sub from_datetime_and_duration {
94 my $class = shift;
95 my %args = @_;
96
97 my $key;
98 my $dt;
99 # extract datetime parameters
100 for ( qw( start end before after ) ) {
101 if ( exists $args{$_} ) {
102 $key = $_;
103 $dt = delete $args{$_};
104 }
105 }
106
107 # extract duration parameters
108 my $dt_duration;
109 if ( exists $args{duration} ) {
110 $dt_duration = $args{duration};
111 }
112 else {
113 $dt_duration = DateTime::Duration->new( %args );
114 }
115 # warn "Creating span from $key => ".$dt->datetime." and $dt_duration";
116 my $other_date;
117 my $other_key;
118 if ( $dt_duration->is_positive ) {
119 if ( $key eq 'end' || $key eq 'before' ) {
120 $other_key = 'start';
121 $other_date = $dt->clone->subtract_duration( $dt_duration );
122 }
123 else {
124 $other_key = 'before';
125 $other_date = $dt->clone->add_duration( $dt_duration );
126 }
127 }
128 else {
129 if ( $key eq 'end' || $key eq 'before' ) {
130 $other_key = 'start';
131 $other_date = $dt->clone->add_duration( $dt_duration );
132 }
133 else {
134 $other_key = 'before';
135 $other_date = $dt->clone->subtract_duration( $dt_duration );
136 }
137 }
138 # warn "Creating span from $key => ".$dt->datetime." and ".$other_date->datetime;
139 return $class->new( $key => $dt, $other_key => $other_date );
140}
141
142# This method is intentionally not documented. It's really only for
143# use by ::Set and ::SpanSet's as_list() and iterator() methods.
144sub new {
145 my $class = shift;
146 my %args = @_;
147
148 # If we find anything _not_ appropriate for from_datetimes, we
149 # assume it must be for durations, and call this constructor.
150 # This way, we don't need to hardcode the DateTime::Duration
151 # parameters.
152 foreach ( keys %args )
153 {
154 return $class->from_datetime_and_duration(%args)
155 unless /^(?:before|after|start|end)$/;
156 }
157
158 return $class->from_datetimes(%args);
159}
160
161sub is_empty_set {
162 my $set = $_[0];
163 $set->{set}->is_null;
164}
165
166sub clone {
167 bless {
168 set => $_[0]->{set}->copy,
169 }, ref $_[0];
170}
171
172# Set::Infinite methods
173
174sub intersection {
175 my ($set1, $set2) = @_;
176 my $class = ref($set1);
177 my $tmp = {}; # $class->new();
178 $set2 = $set2->as_spanset
179 if $set2->can( 'as_spanset' );
180 $set2 = $set2->as_set
181 if $set2->can( 'as_set' );
182 $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] )
183 unless $set2->can( 'union' );
184 $tmp->{set} = $set1->{set}->intersection( $set2->{set} );
185
186 # intersection() can generate something more complex than a span.
187 bless $tmp, 'DateTime::SpanSet';
188
189 return $tmp;
190}
191
192sub intersects {
193 my ($set1, $set2) = @_;
194 my $class = ref($set1);
195 $set2 = $set2->as_spanset
196 if $set2->can( 'as_spanset' );
197 $set2 = $set2->as_set
198 if $set2->can( 'as_set' );
199 $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] )
200 unless $set2->can( 'union' );
201 return $set1->{set}->intersects( $set2->{set} );
202}
203
204sub contains {
205 my ($set1, $set2) = @_;
206 my $class = ref($set1);
207 $set2 = $set2->as_spanset
208 if $set2->can( 'as_spanset' );
209 $set2 = $set2->as_set
210 if $set2->can( 'as_set' );
211 $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] )
212 unless $set2->can( 'union' );
213 return $set1->{set}->contains( $set2->{set} );
214}
215
216sub union {
217 my ($set1, $set2) = @_;
218 my $class = ref($set1);
219 my $tmp = {}; # $class->new();
220 $set2 = $set2->as_spanset
221 if $set2->can( 'as_spanset' );
222 $set2 = $set2->as_set
223 if $set2->can( 'as_set' );
224 $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] )
225 unless $set2->can( 'union' );
226 $tmp->{set} = $set1->{set}->union( $set2->{set} );
227
228 # union() can generate something more complex than a span.
229 bless $tmp, 'DateTime::SpanSet';
230
231 # # We have to check it's internal structure to find out.
232 # if ( $#{ $tmp->{set}->{list} } != 0 ) {
233 # bless $tmp, 'Date::SpanSet';
234 # }
235
236 return $tmp;
237}
238
239sub complement {
240 my ($set1, $set2) = @_;
241 my $class = ref($set1);
242 my $tmp = {}; # $class->new;
243 if (defined $set2) {
244 $set2 = $set2->as_spanset
245 if $set2->can( 'as_spanset' );
246 $set2 = $set2->as_set
247 if $set2->can( 'as_set' );
248 $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] )
249 unless $set2->can( 'union' );
250 $tmp->{set} = $set1->{set}->complement( $set2->{set} );
251 }
252 else {
253 $tmp->{set} = $set1->{set}->complement;
254 }
255
256 # complement() can generate something more complex than a span.
257 bless $tmp, 'DateTime::SpanSet';
258
259 # # We have to check it's internal structure to find out.
260 # if ( $#{ $tmp->{set}->{list} } != 0 ) {
261 # bless $tmp, 'Date::SpanSet';
262 # }
263
264 return $tmp;
265}
266
267sub start {
268 return DateTime::Set::_fix_datetime( $_[0]->{set}->min );
269}
270
27111µs*min = \&start;
272
273sub end {
274 return DateTime::Set::_fix_datetime( $_[0]->{set}->max );
275}
276
2771200ns*max = \&end;
278
279sub start_is_open {
280 # min_a returns info about the set boundary
281 my ($min, $open) = $_[0]->{set}->min_a;
282 return $open;
283}
284
285sub start_is_closed { $_[0]->start_is_open ? 0 : 1 }
286
287sub end_is_open {
288 # max_a returns info about the set boundary
289 my ($max, $open) = $_[0]->{set}->max_a;
290 return $open;
291}
292
293sub end_is_closed { $_[0]->end_is_open ? 0 : 1 }
294
295
296# span == $self
297sub span { @_ }
298
299sub duration {
300 my $dur;
301
302 local $@;
303 eval {
304 local $SIG{__DIE__}; # don't want to trap this (rt ticket 5434)
305 $dur = $_[0]->end->subtract_datetime_absolute( $_[0]->start )
306 };
307
308 return $dur if defined $dur;
309
310 return DateTime::Infinite::Future->new -
311 DateTime::Infinite::Past->new;
312}
3131200ns*size = \&duration;
314
31513µs1;
316
317__END__
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.