| File | /project/perl/lib/Class/Date/Const.pm |
| Statements Executed | 49 |
| Statement Execution Time | 2.31ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 0 | 0 | 0 | 0s | 0s | Class::Date::Const::BEGIN |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Class::Date::Const; | ||||
| 2 | 3 | 103µs | 1 | 27µs | use strict; # spent 27µs making 1 call to strict::import |
| 3 | |||||
| 4 | 3 | 88µs | 1 | 390µs | use vars qw(@EXPORT @ISA @ERROR_MESSAGES %EXPORT_TAGS); # spent 390µs making 1 call to vars::import |
| 5 | 3 | 411µs | 1 | 129µs | use Exporter; # spent 129µs making 1 call to Exporter::import |
| 6 | |||||
| 7 | 1 | 25µs | my %FIELDS = ( | ||
| 8 | # Class::Date fields | ||||
| 9 | c_year => 0, | ||||
| 10 | c_mon => 1, | ||||
| 11 | c_day => 2, | ||||
| 12 | c_hour => 3, | ||||
| 13 | c_min => 4, | ||||
| 14 | c_sec => 5, | ||||
| 15 | c_wday => 6, | ||||
| 16 | c_yday => 7, | ||||
| 17 | c_isdst => 8, | ||||
| 18 | c_epoch => 9, | ||||
| 19 | c_tz => 10, | ||||
| 20 | c_error => 11, | ||||
| 21 | c_errmsg => 12, | ||||
| 22 | # Class::Date::Rel fields | ||||
| 23 | cs_mon => 0, | ||||
| 24 | cs_sec => 1, | ||||
| 25 | # Class::Date::Invalid fields | ||||
| 26 | ci_error => 0, | ||||
| 27 | ci_errmsg => 1, | ||||
| 28 | ); | ||||
| 29 | |||||
| 30 | 2 | 1.07ms | eval " sub $_ () { ".$FIELDS{$_}."}" foreach keys %FIELDS; | ||
| 31 | 1 | 9µs | @ISA = qw(Exporter); | ||
| 32 | |||||
| 33 | 1 | 29µs | my @ERRORS = ( | ||
| 34 | E_OK => '', | ||||
| 35 | E_INVALID => 'Invalid date or time', | ||||
| 36 | E_RANGE => 'Range check on date or time failed', | ||||
| 37 | E_UNPARSABLE => 'Unparsable date or time: %s', | ||||
| 38 | E_UNDEFINED => 'Undefined date object', | ||||
| 39 | ); | ||||
| 40 | |||||
| 41 | 1 | 5µs | my @ERR; | ||
| 42 | # predeclaring error constants | ||||
| 43 | 1 | 5µs | my $c = 0; | ||
| 44 | 1 | 10µs | while (@ERRORS) { | ||
| 45 | 5 | 26µs | my $errorcode = shift @ERRORS; | ||
| 46 | 5 | 23µs | my $errorname = shift @ERRORS; | ||
| 47 | 5 | 320µs | eval "sub $errorcode () { $c }"; | ||
| 48 | 5 | 30µs | $ERROR_MESSAGES[$c] = $errorname; | ||
| 49 | 5 | 32µs | push @{$EXPORT_TAGS{errors}}, $errorcode; | ||
| 50 | 5 | 49µs | $c++; | ||
| 51 | } | ||||
| 52 | |||||
| 53 | 1 | 36µs | @EXPORT = (keys %FIELDS, qw(@ERROR_MESSAGES), @{$EXPORT_TAGS{errors}}); | ||
| 54 | |||||
| 55 | 1 | 41µs | 1; |