| Filename | /usr/lib/perl5/DateTime/Duration.pm |
| Statements | Executed 27 statements in 2.11ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 18µs | 67µs | DateTime::Duration::BEGIN@12 |
| 1 | 1 | 1 | 15µs | 119µs | DateTime::Duration::BEGIN@14 |
| 1 | 1 | 1 | 15µs | 16µs | DateTime::Duration::BEGIN@10 |
| 1 | 1 | 1 | 14µs | 68µs | DateTime::Duration::BEGIN@23 |
| 1 | 1 | 1 | 12µs | 12µs | DateTime::Duration::BEGIN@2 |
| 1 | 1 | 1 | 11µs | 24µs | DateTime::Duration::BEGIN@7 |
| 1 | 1 | 1 | 11µs | 15µs | DateTime::Duration::BEGIN@6 |
| 1 | 1 | 1 | 10µs | 12µs | DateTime::Duration::BEGIN@11 |
| 1 | 1 | 1 | 5µs | 5µs | DateTime::Duration::BEGIN@9 |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::_add_overload |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::_compare_overload |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::_has_negative |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::_has_positive |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::_multiply_overload |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::_normalize_nanoseconds |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::_subtract_overload |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::add |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::add_duration |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::calendar_duration |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::clock_duration |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::clone |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::compare |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::days |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::delta_days |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::delta_minutes |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::delta_months |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::delta_nanoseconds |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::delta_seconds |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::deltas |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::end_of_month_mode |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::hours |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::in_units |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::inverse |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::is_limit_mode |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::is_negative |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::is_positive |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::is_preserve_mode |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::is_wrap_mode |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::is_zero |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::minutes |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::months |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::multiply |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::nanoseconds |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::new |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::seconds |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::subtract |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::subtract_duration |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::weeks |
| 0 | 0 | 0 | 0s | 0s | DateTime::Duration::years |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package DateTime::Duration; | ||||
| 2 | # spent 12µs within DateTime::Duration::BEGIN@2 which was called:
# once (12µs+0s) by DateTime::BEGIN@39 at line 4 | ||||
| 3 | 1 | 8µs | $DateTime::Duration::VERSION = '0.61'; | ||
| 4 | 1 | 23µs | 1 | 12µs | } # spent 12µs making 1 call to DateTime::Duration::BEGIN@2 |
| 5 | |||||
| 6 | 3 | 28µs | 2 | 19µs | # spent 15µs (11+4) within DateTime::Duration::BEGIN@6 which was called:
# once (11µs+4µs) by DateTime::BEGIN@39 at line 6 # spent 15µs making 1 call to DateTime::Duration::BEGIN@6
# spent 4µs making 1 call to strict::import |
| 7 | 3 | 27µs | 2 | 37µs | # spent 24µs (11+13) within DateTime::Duration::BEGIN@7 which was called:
# once (11µs+13µs) by DateTime::BEGIN@39 at line 7 # spent 24µs making 1 call to DateTime::Duration::BEGIN@7
# spent 13µs making 1 call to warnings::import |
| 8 | |||||
| 9 | 3 | 23µs | 1 | 5µs | # spent 5µs within DateTime::Duration::BEGIN@9 which was called:
# once (5µs+0s) by DateTime::BEGIN@39 at line 9 # spent 5µs making 1 call to DateTime::Duration::BEGIN@9 |
| 10 | 3 | 35µs | 2 | 18µs | # spent 16µs (15+2) within DateTime::Duration::BEGIN@10 which was called:
# once (15µs+2µs) by DateTime::BEGIN@39 at line 10 # spent 16µs making 1 call to DateTime::Duration::BEGIN@10
# spent 2µs making 1 call to UNIVERSAL::import |
| 11 | 3 | 29µs | 2 | 14µs | # spent 12µs (10+2) within DateTime::Duration::BEGIN@11 which was called:
# once (10µs+2µs) by DateTime::BEGIN@39 at line 11 # spent 12µs making 1 call to DateTime::Duration::BEGIN@11
# spent 2µs making 1 call to UNIVERSAL::import |
| 12 | 3 | 57µs | 2 | 117µs | # spent 67µs (18+49) within DateTime::Duration::BEGIN@12 which was called:
# once (18µs+49µs) by DateTime::BEGIN@39 at line 12 # spent 67µs making 1 call to DateTime::Duration::BEGIN@12
# spent 49µs making 1 call to Exporter::import |
| 13 | |||||
| 14 | # spent 119µs (15+104) within DateTime::Duration::BEGIN@14 which was called:
# once (15µs+104µs) by DateTime::BEGIN@39 at line 21 | ||||
| 15 | 1 | 10µs | 1 | 104µs | fallback => 1, # spent 104µs making 1 call to overload::import |
| 16 | '+' => '_add_overload', | ||||
| 17 | '-' => '_subtract_overload', | ||||
| 18 | '*' => '_multiply_overload', | ||||
| 19 | '<=>' => '_compare_overload', | ||||
| 20 | 'cmp' => '_compare_overload', | ||||
| 21 | 2 | 33µs | 1 | 119µs | ); # spent 119µs making 1 call to DateTime::Duration::BEGIN@14 |
| 22 | |||||
| 23 | 3 | 1.83ms | 2 | 122µs | # spent 68µs (14+54) within DateTime::Duration::BEGIN@23 which was called:
# once (14µs+54µs) by DateTime::BEGIN@39 at line 23 # spent 68µs making 1 call to DateTime::Duration::BEGIN@23
# spent 54µs making 1 call to constant::import |
| 24 | |||||
| 25 | 1 | 2µs | my @all_units = qw( months days minutes seconds nanoseconds ); | ||
| 26 | |||||
| 27 | # XXX - need to reject non-integers but accept infinity, NaN, & | ||||
| 28 | # 1.56e+18 | ||||
| 29 | sub new { | ||||
| 30 | my $class = shift; | ||||
| 31 | my %p = validate( | ||||
| 32 | @_, { | ||||
| 33 | years => { type => SCALAR, default => 0 }, | ||||
| 34 | months => { type => SCALAR, default => 0 }, | ||||
| 35 | weeks => { type => SCALAR, default => 0 }, | ||||
| 36 | days => { type => SCALAR, default => 0 }, | ||||
| 37 | hours => { type => SCALAR, default => 0 }, | ||||
| 38 | minutes => { type => SCALAR, default => 0 }, | ||||
| 39 | seconds => { type => SCALAR, default => 0 }, | ||||
| 40 | nanoseconds => { type => SCALAR, default => 0 }, | ||||
| 41 | end_of_month => { | ||||
| 42 | type => SCALAR, default => undef, | ||||
| 43 | regex => qr/^(?:wrap|limit|preserve)$/ | ||||
| 44 | }, | ||||
| 45 | } | ||||
| 46 | ); | ||||
| 47 | |||||
| 48 | my $self = bless {}, $class; | ||||
| 49 | |||||
| 50 | $self->{months} = ( $p{years} * 12 ) + $p{months}; | ||||
| 51 | |||||
| 52 | $self->{days} = ( $p{weeks} * 7 ) + $p{days}; | ||||
| 53 | |||||
| 54 | $self->{minutes} = ( $p{hours} * 60 ) + $p{minutes}; | ||||
| 55 | |||||
| 56 | $self->{seconds} = $p{seconds}; | ||||
| 57 | |||||
| 58 | if ( $p{nanoseconds} ) { | ||||
| 59 | $self->{nanoseconds} = $p{nanoseconds}; | ||||
| 60 | $self->_normalize_nanoseconds; | ||||
| 61 | } | ||||
| 62 | else { | ||||
| 63 | |||||
| 64 | # shortcut - if they don't need nanoseconds | ||||
| 65 | $self->{nanoseconds} = 0; | ||||
| 66 | } | ||||
| 67 | |||||
| 68 | $self->{end_of_month} = ( | ||||
| 69 | defined $p{end_of_month} ? $p{end_of_month} | ||||
| 70 | : $self->{months} < 0 ? 'preserve' | ||||
| 71 | : 'wrap' | ||||
| 72 | ); | ||||
| 73 | |||||
| 74 | return $self; | ||||
| 75 | } | ||||
| 76 | |||||
| 77 | # make the signs of seconds, nanos the same; 0 < abs(nanos) < MAX_NANOS | ||||
| 78 | # NB this requires nanoseconds != 0 (callers check this already) | ||||
| 79 | sub _normalize_nanoseconds { | ||||
| 80 | my $self = shift; | ||||
| 81 | |||||
| 82 | return | ||||
| 83 | if ( $self->{nanoseconds} == DateTime::INFINITY() | ||||
| 84 | || $self->{nanoseconds} == DateTime::NEG_INFINITY() | ||||
| 85 | || $self->{nanoseconds} eq DateTime::NAN() ); | ||||
| 86 | |||||
| 87 | my $seconds = $self->{seconds} + $self->{nanoseconds} / MAX_NANOSECONDS; | ||||
| 88 | $self->{seconds} = int($seconds); | ||||
| 89 | $self->{nanoseconds} = $self->{nanoseconds} % MAX_NANOSECONDS; | ||||
| 90 | $self->{nanoseconds} -= MAX_NANOSECONDS if $seconds < 0; | ||||
| 91 | } | ||||
| 92 | |||||
| 93 | sub clone { bless { %{ $_[0] } }, ref $_[0] } | ||||
| 94 | |||||
| 95 | sub years { abs( $_[0]->in_units('years') ) } | ||||
| 96 | sub months { abs( $_[0]->in_units( 'months', 'years' ) ) } | ||||
| 97 | sub weeks { abs( $_[0]->in_units('weeks') ) } | ||||
| 98 | sub days { abs( $_[0]->in_units( 'days', 'weeks' ) ) } | ||||
| 99 | sub hours { abs( $_[0]->in_units('hours') ) } | ||||
| 100 | sub minutes { abs( $_[0]->in_units( 'minutes', 'hours' ) ) } | ||||
| 101 | sub seconds { abs( $_[0]->in_units('seconds') ) } | ||||
| 102 | sub nanoseconds { abs( $_[0]->in_units( 'nanoseconds', 'seconds' ) ) } | ||||
| 103 | |||||
| 104 | sub is_positive { $_[0]->_has_positive && !$_[0]->_has_negative } | ||||
| 105 | sub is_negative { !$_[0]->_has_positive && $_[0]->_has_negative } | ||||
| 106 | |||||
| 107 | sub _has_positive { | ||||
| 108 | ( grep { $_ > 0 } @{ $_[0] }{@all_units} ) ? 1 : 0; | ||||
| 109 | } | ||||
| 110 | |||||
| 111 | sub _has_negative { | ||||
| 112 | ( grep { $_ < 0 } @{ $_[0] }{@all_units} ) ? 1 : 0; | ||||
| 113 | } | ||||
| 114 | |||||
| 115 | sub is_zero { | ||||
| 116 | return 0 if grep { $_ != 0 } @{ $_[0] }{@all_units}; | ||||
| 117 | return 1; | ||||
| 118 | } | ||||
| 119 | |||||
| 120 | sub delta_months { $_[0]->{months} } | ||||
| 121 | sub delta_days { $_[0]->{days} } | ||||
| 122 | sub delta_minutes { $_[0]->{minutes} } | ||||
| 123 | sub delta_seconds { $_[0]->{seconds} } | ||||
| 124 | sub delta_nanoseconds { $_[0]->{nanoseconds} } | ||||
| 125 | |||||
| 126 | sub deltas { | ||||
| 127 | map { $_ => $_[0]->{$_} } @all_units; | ||||
| 128 | } | ||||
| 129 | |||||
| 130 | sub in_units { | ||||
| 131 | my $self = shift; | ||||
| 132 | my @units = @_; | ||||
| 133 | |||||
| 134 | my %units = map { $_ => 1 } @units; | ||||
| 135 | |||||
| 136 | my %ret; | ||||
| 137 | |||||
| 138 | my ( $months, $days, $minutes, $seconds ) | ||||
| 139 | = @{$self}{qw( months days minutes seconds )}; | ||||
| 140 | |||||
| 141 | if ( $units{years} ) { | ||||
| 142 | $ret{years} = int( $months / 12 ); | ||||
| 143 | $months -= $ret{years} * 12; | ||||
| 144 | } | ||||
| 145 | |||||
| 146 | if ( $units{months} ) { | ||||
| 147 | $ret{months} = $months; | ||||
| 148 | } | ||||
| 149 | |||||
| 150 | if ( $units{weeks} ) { | ||||
| 151 | $ret{weeks} = int( $days / 7 ); | ||||
| 152 | $days -= $ret{weeks} * 7; | ||||
| 153 | } | ||||
| 154 | |||||
| 155 | if ( $units{days} ) { | ||||
| 156 | $ret{days} = $days; | ||||
| 157 | } | ||||
| 158 | |||||
| 159 | if ( $units{hours} ) { | ||||
| 160 | $ret{hours} = int( $minutes / 60 ); | ||||
| 161 | $minutes -= $ret{hours} * 60; | ||||
| 162 | } | ||||
| 163 | |||||
| 164 | if ( $units{minutes} ) { | ||||
| 165 | $ret{minutes} = $minutes; | ||||
| 166 | } | ||||
| 167 | |||||
| 168 | if ( $units{seconds} ) { | ||||
| 169 | $ret{seconds} = $seconds; | ||||
| 170 | $seconds = 0; | ||||
| 171 | } | ||||
| 172 | |||||
| 173 | if ( $units{nanoseconds} ) { | ||||
| 174 | $ret{nanoseconds} = $seconds * MAX_NANOSECONDS + $self->{nanoseconds}; | ||||
| 175 | } | ||||
| 176 | |||||
| 177 | wantarray ? @ret{@units} : $ret{ $units[0] }; | ||||
| 178 | } | ||||
| 179 | |||||
| 180 | sub is_wrap_mode { $_[0]->{end_of_month} eq 'wrap' ? 1 : 0 } | ||||
| 181 | sub is_limit_mode { $_[0]->{end_of_month} eq 'limit' ? 1 : 0 } | ||||
| 182 | sub is_preserve_mode { $_[0]->{end_of_month} eq 'preserve' ? 1 : 0 } | ||||
| 183 | |||||
| 184 | sub end_of_month_mode { $_[0]->{end_of_month} } | ||||
| 185 | |||||
| 186 | sub calendar_duration { | ||||
| 187 | my $self = shift; | ||||
| 188 | |||||
| 189 | return ( ref $self ) | ||||
| 190 | ->new( map { $_ => $self->{$_} } qw( months days end_of_month ) ); | ||||
| 191 | } | ||||
| 192 | |||||
| 193 | sub clock_duration { | ||||
| 194 | my $self = shift; | ||||
| 195 | |||||
| 196 | return ( ref $self ) | ||||
| 197 | ->new( map { $_ => $self->{$_} } | ||||
| 198 | qw( minutes seconds nanoseconds end_of_month ) ); | ||||
| 199 | } | ||||
| 200 | |||||
| 201 | sub inverse { | ||||
| 202 | my $self = shift; | ||||
| 203 | my %p = @_; | ||||
| 204 | |||||
| 205 | my %new; | ||||
| 206 | foreach my $u (@all_units) { | ||||
| 207 | $new{$u} = $self->{$u}; | ||||
| 208 | |||||
| 209 | # avoid -0 bug | ||||
| 210 | $new{$u} *= -1 if $new{$u}; | ||||
| 211 | } | ||||
| 212 | |||||
| 213 | $new{end_of_month} = $p{end_of_month} | ||||
| 214 | if exists $p{end_of_month}; | ||||
| 215 | |||||
| 216 | return ( ref $self )->new(%new); | ||||
| 217 | } | ||||
| 218 | |||||
| 219 | sub add_duration { | ||||
| 220 | my ( $self, $dur ) = @_; | ||||
| 221 | |||||
| 222 | foreach my $u (@all_units) { | ||||
| 223 | $self->{$u} += $dur->{$u}; | ||||
| 224 | } | ||||
| 225 | |||||
| 226 | $self->_normalize_nanoseconds if $self->{nanoseconds}; | ||||
| 227 | |||||
| 228 | return $self; | ||||
| 229 | } | ||||
| 230 | |||||
| 231 | sub add { | ||||
| 232 | my $self = shift; | ||||
| 233 | |||||
| 234 | return $self->add_duration( ( ref $self )->new(@_) ); | ||||
| 235 | } | ||||
| 236 | |||||
| 237 | sub subtract_duration { return $_[0]->add_duration( $_[1]->inverse ) } | ||||
| 238 | |||||
| 239 | sub subtract { | ||||
| 240 | my $self = shift; | ||||
| 241 | |||||
| 242 | return $self->subtract_duration( ( ref $self )->new(@_) ); | ||||
| 243 | } | ||||
| 244 | |||||
| 245 | sub multiply { | ||||
| 246 | my $self = shift; | ||||
| 247 | my $multiplier = shift; | ||||
| 248 | |||||
| 249 | foreach my $u (@all_units) { | ||||
| 250 | $self->{$u} *= $multiplier; | ||||
| 251 | } | ||||
| 252 | |||||
| 253 | $self->_normalize_nanoseconds if $self->{nanoseconds}; | ||||
| 254 | |||||
| 255 | return $self; | ||||
| 256 | } | ||||
| 257 | |||||
| 258 | sub compare { | ||||
| 259 | my ( $class, $dur1, $dur2, $dt ) = @_; | ||||
| 260 | |||||
| 261 | $dt ||= DateTime->now; | ||||
| 262 | |||||
| 263 | return DateTime->compare( $dt->clone->add_duration($dur1), | ||||
| 264 | $dt->clone->add_duration($dur2) ); | ||||
| 265 | } | ||||
| 266 | |||||
| 267 | sub _add_overload { | ||||
| 268 | my ( $d1, $d2, $rev ) = @_; | ||||
| 269 | |||||
| 270 | ( $d1, $d2 ) = ( $d2, $d1 ) if $rev; | ||||
| 271 | |||||
| 272 | if ( DateTime::Helpers::isa( $d2, 'DateTime' ) ) { | ||||
| 273 | $d2->add_duration($d1); | ||||
| 274 | return; | ||||
| 275 | } | ||||
| 276 | |||||
| 277 | # will also work if $d1 is a DateTime.pm object | ||||
| 278 | return $d1->clone->add_duration($d2); | ||||
| 279 | } | ||||
| 280 | |||||
| 281 | sub _subtract_overload { | ||||
| 282 | my ( $d1, $d2, $rev ) = @_; | ||||
| 283 | |||||
| 284 | ( $d1, $d2 ) = ( $d2, $d1 ) if $rev; | ||||
| 285 | |||||
| 286 | Carp::croak( | ||||
| 287 | "Cannot subtract a DateTime object from a DateTime::Duration object") | ||||
| 288 | if DateTime::Helpers::isa( $d2, 'DateTime' ); | ||||
| 289 | |||||
| 290 | return $d1->clone->subtract_duration($d2); | ||||
| 291 | } | ||||
| 292 | |||||
| 293 | sub _multiply_overload { | ||||
| 294 | my $self = shift; | ||||
| 295 | |||||
| 296 | my $new = $self->clone; | ||||
| 297 | |||||
| 298 | return $new->multiply(@_); | ||||
| 299 | } | ||||
| 300 | |||||
| 301 | sub _compare_overload { | ||||
| 302 | Carp::croak( 'DateTime::Duration does not overload comparison.' | ||||
| 303 | . ' See the documentation on the compare() method for details.' | ||||
| 304 | ); | ||||
| 305 | } | ||||
| 306 | |||||
| 307 | 1 | 4µs | 1; | ||
| 308 | |||||
| 309 | # ABSTRACT: Duration objects for date math | ||||
| 310 | |||||
| - - | |||||
| 313 | =pod | ||||
| 314 | |||||
| - - | |||||
| 625 | __END__ |