line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2
|
|
|
|
|
|
|
# File: Shift.pl |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# Description: ExifTool time shifting routines |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# Revisions: 10/28/2005 - P. Harvey Created |
7
|
|
|
|
|
|
|
# 03/13/2019 - PH Added single-argument form of ShiftTime() |
8
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
package Image::ExifTool; |
11
|
|
|
|
|
|
|
|
12
|
3
|
|
|
3
|
|
27
|
use strict; |
|
3
|
|
|
|
|
13
|
|
|
3
|
|
|
|
|
10071
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
sub ShiftTime($;$$$); |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
17
|
|
|
|
|
|
|
# apply shift to value in new value hash |
18
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) shift type, 2) shift string, 3) raw date/time value, |
19
|
|
|
|
|
|
|
# 4) new value hash ref |
20
|
|
|
|
|
|
|
# Returns: error string or undef on success and updates value in new value hash |
21
|
|
|
|
|
|
|
sub ApplyShift($$$$;$) |
22
|
|
|
|
|
|
|
{ |
23
|
13
|
|
|
13
|
0
|
50
|
my ($self, $func, $shift, $val, $nvHash) = @_; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# get shift direction from first character in shift string |
26
|
13
|
100
|
|
|
|
107
|
my $pre = ($shift =~ s/^(\+|-)//) ? $1 : '+'; |
27
|
13
|
100
|
|
|
|
59
|
my $dir = ($pre eq '+') ? 1 : -1; |
28
|
13
|
|
|
|
|
31
|
my $tagInfo = $$nvHash{TagInfo}; |
29
|
13
|
|
|
|
|
52
|
my $tag = $$tagInfo{Name}; |
30
|
13
|
|
|
|
|
35
|
my $shiftOffset; |
31
|
13
|
50
|
|
|
|
86
|
if ($$nvHash{ShiftOffset}) { |
32
|
0
|
|
|
|
|
0
|
$shiftOffset = $$nvHash{ShiftOffset}; |
33
|
|
|
|
|
|
|
} else { |
34
|
13
|
|
|
|
|
74
|
$shiftOffset = $$nvHash{ShiftOffset} = { }; |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# initialize handler for eval warnings |
38
|
13
|
|
|
|
|
83
|
local $SIG{'__WARN__'} = \&SetWarning; |
39
|
13
|
|
|
|
|
66
|
SetWarning(undef); |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
# shift is applied to ValueConv value, so we must ValueConv-Shift-ValueConvInv |
42
|
13
|
|
|
|
|
30
|
my ($type, $err); |
43
|
13
|
|
|
|
|
52
|
foreach $type ('ValueConv','Shift','ValueConvInv') { |
44
|
39
|
100
|
|
|
|
137
|
if ($type eq 'Shift') { |
|
|
100
|
|
|
|
|
|
45
|
|
|
|
|
|
|
#### eval ShiftXxx function |
46
|
13
|
|
|
|
|
1127
|
$err = eval "Shift$func(\$val, \$shift, \$dir, \$shiftOffset)"; |
47
|
|
|
|
|
|
|
} elsif ($$tagInfo{$type}) { |
48
|
4
|
|
|
|
|
22
|
my $conv = $$tagInfo{$type}; |
49
|
4
|
50
|
|
|
|
20
|
if (ref $conv eq 'CODE') { |
50
|
0
|
|
|
|
|
0
|
$val = &$conv($val, $self); |
51
|
|
|
|
|
|
|
} else { |
52
|
4
|
50
|
|
|
|
11
|
return "Can't handle $type for $tag in ApplyShift()" if ref $$tagInfo{$type}; |
53
|
|
|
|
|
|
|
#### eval ValueConv/ValueConvInv ($val, $self) |
54
|
4
|
|
|
|
|
302
|
$val = eval $$tagInfo{$type}; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
} else { |
57
|
22
|
|
|
|
|
61
|
next; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
# handle errors |
60
|
17
|
50
|
|
|
|
87
|
$err and return $err; |
61
|
17
|
50
|
|
|
|
47
|
$@ and SetWarning($@); |
62
|
17
|
50
|
|
|
|
63
|
GetWarning() and return CleanWarning(); |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
# update value in new value hash |
65
|
13
|
|
|
|
|
63
|
$nvHash->{Value} = [ $val ]; |
66
|
13
|
|
|
|
|
90
|
return undef; # success |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
70
|
|
|
|
|
|
|
# Check date/time shift |
71
|
|
|
|
|
|
|
# Inputs: 0) shift type, 1) shift string (without sign) |
72
|
|
|
|
|
|
|
# Returns: updated shift string, or undef on error (and may update shift) |
73
|
|
|
|
|
|
|
sub CheckShift($$) |
74
|
|
|
|
|
|
|
{ |
75
|
47
|
|
|
47
|
0
|
118
|
my ($type, $shift) = @_; |
76
|
47
|
|
|
|
|
82
|
my $err; |
77
|
47
|
50
|
|
|
|
106
|
if ($type eq 'Time') { |
78
|
47
|
50
|
|
|
|
249
|
return "No shift direction" unless $shift =~ s/^(\+|-)//; |
79
|
|
|
|
|
|
|
# do a test shift to validate the shift string |
80
|
47
|
|
|
|
|
98
|
my $testTime = '2005:11:02 09:00:13.25-04:00'; |
81
|
47
|
100
|
|
|
|
199
|
$err = ShiftTime($testTime, $shift, $1 eq '+' ? 1 : -1); |
82
|
|
|
|
|
|
|
} else { |
83
|
0
|
|
|
|
|
0
|
$err = "Unknown shift type ($type)"; |
84
|
|
|
|
|
|
|
} |
85
|
47
|
|
|
|
|
161
|
return $err; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
89
|
|
|
|
|
|
|
# return the number of days in a month |
90
|
|
|
|
|
|
|
# Inputs: 0) month number (Jan=1, may be outside range), 1) year |
91
|
|
|
|
|
|
|
# Returns: number of days in month |
92
|
|
|
|
|
|
|
sub DaysInMonth($$) |
93
|
|
|
|
|
|
|
{ |
94
|
49
|
|
|
49
|
0
|
82
|
my ($mon, $year) = @_; |
95
|
49
|
|
|
|
|
113
|
my @days = (31,28,31,30,31,30,31,31,30,31,30,31); |
96
|
|
|
|
|
|
|
# adjust to the range [0,11] |
97
|
49
|
|
|
|
|
99
|
while ($mon < 1) { $mon += 12; --$year; } |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
8
|
|
98
|
49
|
|
|
|
|
87
|
while ($mon > 12) { $mon -= 12; ++$year; } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
99
|
|
|
|
|
|
|
# return standard number of days unless february on a leap year |
100
|
49
|
50
|
66
|
|
|
185
|
return $days[$mon-1] unless $mon == 2 and not $year % 4; |
101
|
|
|
|
|
|
|
# leap years don't occur on even centuries except every 400 years |
102
|
0
|
0
|
0
|
|
|
0
|
return 29 if $year % 100 or not $year % 400; |
103
|
0
|
|
|
|
|
0
|
return 28; |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
107
|
|
|
|
|
|
|
# split times into corresponding components: YYYY mm dd HH MM SS tzh tzm |
108
|
|
|
|
|
|
|
# Inputs: 0) date/time or shift string 1) reference to list for returned components |
109
|
|
|
|
|
|
|
# 2) optional reference to list of time components (if shift string) |
110
|
|
|
|
|
|
|
# Returns: true on success |
111
|
|
|
|
|
|
|
# Returned components are 0-Y, 1-M, 2-D, 3-hr, 4-min, 5-sec, 6-tzhr, 7-tzmin |
112
|
|
|
|
|
|
|
sub SplitTime($$;$) |
113
|
|
|
|
|
|
|
{ |
114
|
118
|
|
|
118
|
0
|
254
|
my ($val, $vals, $time) = @_; |
115
|
|
|
|
|
|
|
# insert zeros if missing in shift string |
116
|
118
|
100
|
|
|
|
269
|
if ($time) { |
117
|
56
|
|
|
|
|
200
|
$val =~ s/(^|[-+:\s]):/${1}0:/g; |
118
|
56
|
|
|
|
|
180
|
$val =~ s/:([:\s]|$)/:0$1/g; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
# change dashes to colons in date (for XMP dates) |
121
|
118
|
50
|
|
|
|
295
|
if ($val =~ s/^(\d{4})-(\d{2})-(\d{2})/$1:$2:$3/) { |
122
|
0
|
|
|
|
|
0
|
$val =~ tr/T/ /; # change 'T' separator to ' ' |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
# add space before timezone to split it into a separate word |
125
|
118
|
|
|
|
|
554
|
$val =~ s/(\+|-)/ $1/; |
126
|
118
|
|
|
|
|
351
|
my @words = split ' ', $val; |
127
|
118
|
|
|
|
|
201
|
my $err = 1; |
128
|
118
|
|
|
|
|
180
|
my @v; |
129
|
118
|
|
|
|
|
177
|
for (;;) { |
130
|
362
|
|
|
|
|
549
|
my $word = shift @words; |
131
|
362
|
100
|
|
|
|
722
|
last unless defined $word; |
132
|
|
|
|
|
|
|
# split word into separate numbers (allow decimal points but no signs) |
133
|
244
|
50
|
|
|
|
1647
|
my @vals = $word =~ /(?=\d|\.\d)\d*(?:\.\d*)?/g or last; |
134
|
244
|
100
|
100
|
|
|
1783
|
if ($word =~ /^(\+|-)/) { |
|
|
100
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
135
|
|
|
|
|
|
|
# this is the timezone |
136
|
50
|
50
|
33
|
|
|
200
|
(defined $v[6] or @vals > 2) and $err = 1, last; |
137
|
50
|
100
|
|
|
|
171
|
my $sign = ($1 ne '-') ? 1 : -1; |
138
|
|
|
|
|
|
|
# apply sign to both minutes and seconds |
139
|
50
|
|
|
|
|
144
|
$v[6] = $sign * shift(@vals); |
140
|
50
|
|
50
|
|
|
146
|
$v[7] = $sign * (shift(@vals) || 0); |
141
|
|
|
|
|
|
|
} elsif ((@words and $words[0] =~ /^\d+/) or # there is a time word to follow |
142
|
|
|
|
|
|
|
(not $time and $vals[0] =~ /^\d{3}/) or # first value is year (3 or more digits) |
143
|
|
|
|
|
|
|
($time and not defined $$time[3] and not defined $v[0])) # we don't have a time |
144
|
|
|
|
|
|
|
{ |
145
|
|
|
|
|
|
|
# this is a date (must come first) |
146
|
79
|
50
|
33
|
|
|
317
|
(@v or @vals > 3) and $err = 1, last; |
147
|
79
|
50
|
66
|
|
|
302
|
not $time and @vals != 3 and $err = 1, last; |
148
|
79
|
|
|
|
|
161
|
$v[2] = pop(@vals); # take day first if only one specified |
149
|
79
|
|
100
|
|
|
230
|
$v[1] = pop(@vals) || 0; |
150
|
79
|
|
100
|
|
|
194
|
$v[0] = pop(@vals) || 0; |
151
|
|
|
|
|
|
|
} else { |
152
|
|
|
|
|
|
|
# this is a time (can't come after timezone) |
153
|
115
|
50
|
33
|
|
|
615
|
(defined $v[3] or defined $v[6] or @vals > 3) and $err = 1, last; |
|
|
|
33
|
|
|
|
|
154
|
115
|
50
|
66
|
|
|
430
|
not $time and @vals != 3 and @vals != 2 and $err = 1, last; |
|
|
|
33
|
|
|
|
|
155
|
115
|
|
|
|
|
204
|
$v[3] = shift(@vals); # take hour first if only one specified |
156
|
115
|
|
100
|
|
|
288
|
$v[4] = shift(@vals) || 0; |
157
|
115
|
|
100
|
|
|
316
|
$v[5] = shift(@vals) || 0; |
158
|
|
|
|
|
|
|
} |
159
|
244
|
|
|
|
|
475
|
$err = 0; |
160
|
|
|
|
|
|
|
} |
161
|
118
|
50
|
33
|
|
|
418
|
return 0 if $err or not @v; |
162
|
118
|
100
|
|
|
|
249
|
if ($time) { |
163
|
|
|
|
|
|
|
# zero any required shift entries which aren't yet defined |
164
|
56
|
100
|
66
|
|
|
251
|
$v[0] = $v[1] = $v[2] = 0 if defined $$time[0] and not defined $v[0]; |
165
|
56
|
50
|
66
|
|
|
221
|
$v[3] = $v[4] = $v[5] = 0 if defined $$time[3] and not defined $v[3]; |
166
|
56
|
100
|
66
|
|
|
279
|
$v[6] = $v[7] = 0 if defined $$time[6] and not defined $v[6]; |
167
|
|
|
|
|
|
|
} |
168
|
118
|
|
|
|
|
476
|
@$vals = @v; # return split time components |
169
|
118
|
|
|
|
|
408
|
return 1; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
173
|
|
|
|
|
|
|
# shift date/time by components |
174
|
|
|
|
|
|
|
# Inputs: 0) split date/time list ref, 1) split shift list ref, |
175
|
|
|
|
|
|
|
# 2) shift direction, 3) reference to output list of shifted components |
176
|
|
|
|
|
|
|
# 4) number of decimal points in seconds |
177
|
|
|
|
|
|
|
# 5) reference to return time difference due to rounding |
178
|
|
|
|
|
|
|
# Returns: error string or undef on success |
179
|
|
|
|
|
|
|
sub ShiftComponents($$$$$;$) |
180
|
|
|
|
|
|
|
{ |
181
|
56
|
|
|
56
|
0
|
151
|
my ($time, $shift, $dir, $toTime, $dec, $rndPt) = @_; |
182
|
|
|
|
|
|
|
# min/max for Y, M, D, h, m, s |
183
|
56
|
|
|
|
|
116
|
my @min = ( 0, 1, 1, 0, 0, 0); |
184
|
56
|
|
|
|
|
156
|
my @max = (10000,12,28,24,60,60); |
185
|
56
|
|
|
|
|
80
|
my $i; |
186
|
|
|
|
|
|
|
# |
187
|
|
|
|
|
|
|
# apply the shift |
188
|
|
|
|
|
|
|
# |
189
|
56
|
|
|
|
|
99
|
my $c = 0; |
190
|
56
|
|
|
|
|
145
|
for ($i=0; $i<@$time; ++$i) { |
191
|
430
|
|
100
|
|
|
1535
|
my $v = ($$time[$i] || 0) + $dir * ($$shift[$i] || 0) + $c; |
|
|
|
100
|
|
|
|
|
192
|
|
|
|
|
|
|
# handle fractional values by propagating remainders downwards |
193
|
430
|
50
|
66
|
|
|
975
|
if ($v != int($v) and $i < 5) { |
194
|
0
|
|
|
|
|
0
|
my $iv = int($v); |
195
|
0
|
|
|
|
|
0
|
$c = ($v - $iv) * $max[$i+1]; |
196
|
0
|
|
|
|
|
0
|
$v = $iv; |
197
|
|
|
|
|
|
|
} else { |
198
|
430
|
|
|
|
|
557
|
$c = 0; |
199
|
|
|
|
|
|
|
} |
200
|
430
|
|
|
|
|
970
|
$$toTime[$i] = $v; |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
# round off seconds to the required number of decimal points |
203
|
56
|
|
|
|
|
114
|
my $sec = $$toTime[5]; |
204
|
56
|
100
|
100
|
|
|
222
|
if (defined $sec and $sec != int($sec)) { |
205
|
47
|
|
|
|
|
94
|
my $mult = 10 ** $dec; |
206
|
47
|
|
|
|
|
109
|
my $rndSec = int($sec * $mult + 0.5 * ($sec <=> 0)) / $mult; |
207
|
47
|
50
|
|
|
|
136
|
$rndPt and $$rndPt = $sec - $rndSec; |
208
|
47
|
|
|
|
|
88
|
$$toTime[5] = $rndSec; |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
# |
211
|
|
|
|
|
|
|
# handle overflows, starting with least significant number first (seconds) |
212
|
|
|
|
|
|
|
# |
213
|
56
|
|
|
|
|
96
|
$c = 0; |
214
|
56
|
|
|
|
|
147
|
for ($i=5; $i>=0; $i--) { |
215
|
336
|
100
|
|
|
|
605
|
defined $$time[$i] or $c = 0, next; |
216
|
|
|
|
|
|
|
# apply shift and adjust for previous overflow |
217
|
330
|
|
|
|
|
484
|
my $v = $$toTime[$i] + $c; |
218
|
330
|
|
|
|
|
428
|
$c = 0; # set carry to zero |
219
|
|
|
|
|
|
|
# adjust for over/underflow |
220
|
330
|
|
|
|
|
571
|
my ($min, $max) = ($min[$i], $max[$i]); |
221
|
330
|
100
|
|
|
|
785
|
if ($v < $min) { |
|
|
50
|
|
|
|
|
|
222
|
33
|
100
|
|
|
|
114
|
if ($i == 2) { # 2 = day of month |
223
|
7
|
|
|
|
|
12
|
do { |
224
|
|
|
|
|
|
|
# add number of days in previous month |
225
|
49
|
|
|
|
|
70
|
--$c; |
226
|
49
|
|
|
|
|
83
|
my $mon = $$toTime[$i-1] + $c; |
227
|
49
|
|
|
|
|
122
|
$v += DaysInMonth($mon, $$toTime[$i-2]); |
228
|
|
|
|
|
|
|
} while ($v < 1); |
229
|
|
|
|
|
|
|
} else { |
230
|
26
|
|
|
|
|
52
|
my $fc = ($v - $min) / $max; |
231
|
|
|
|
|
|
|
# carry ($c) must be largest integer equal to or less than $fc |
232
|
26
|
|
|
|
|
41
|
$c = int($fc); |
233
|
26
|
50
|
|
|
|
60
|
--$c if $c > $fc; |
234
|
26
|
|
|
|
|
43
|
$v -= $c * $max; |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
} elsif ($v >= $max + $min) { |
237
|
0
|
0
|
|
|
|
0
|
if ($i == 2) { |
238
|
0
|
|
|
|
|
0
|
for (;;) { |
239
|
|
|
|
|
|
|
# test against number of days in current month |
240
|
0
|
|
|
|
|
0
|
my $mon = $$toTime[$i-1] + $c; |
241
|
0
|
|
|
|
|
0
|
my $days = DaysInMonth($mon, $$toTime[$i-2]); |
242
|
0
|
0
|
|
|
|
0
|
last if $v <= $days; |
243
|
0
|
|
|
|
|
0
|
$v -= $days; |
244
|
0
|
|
|
|
|
0
|
++$c; |
245
|
0
|
0
|
|
|
|
0
|
last if $v <= 28; |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
} else { |
248
|
0
|
|
|
|
|
0
|
my $fc = ($v - $max - $min) / $max; |
249
|
|
|
|
|
|
|
# carry ($c) must be smallest integer greater than $fc |
250
|
0
|
|
|
|
|
0
|
$c = int($fc); |
251
|
0
|
0
|
|
|
|
0
|
++$c if $c <= $fc; |
252
|
0
|
|
|
|
|
0
|
$v -= $c * $max; |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
} |
255
|
330
|
|
|
|
|
674
|
$$toTime[$i] = $v; # save the new value |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
# handle overflows in timezone |
258
|
56
|
100
|
|
|
|
165
|
if (defined $$toTime[6]) { |
259
|
50
|
|
|
|
|
94
|
my $m = $$toTime[6] * 60 + $$toTime[7]; |
260
|
50
|
|
|
|
|
100
|
$m += 0.5 * ($m <=> 0); # avoid round-off errors |
261
|
50
|
|
|
|
|
101
|
$$toTime[6] = int($m / 60); |
262
|
50
|
|
|
|
|
109
|
$$toTime[7] = int($m - $$toTime[6] * 60); |
263
|
|
|
|
|
|
|
} |
264
|
56
|
|
|
|
|
154
|
return undef; # success |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
268
|
|
|
|
|
|
|
# Shift an integer or floating-point number |
269
|
|
|
|
|
|
|
# Inputs: 0) date/time string, 1) shift string, 2) shift direction (+1 or -1) |
270
|
|
|
|
|
|
|
# 3) (unused) |
271
|
|
|
|
|
|
|
# Returns: undef and updates input value |
272
|
|
|
|
|
|
|
sub ShiftNumber($$$;$) |
273
|
|
|
|
|
|
|
{ |
274
|
6
|
|
|
6
|
0
|
24
|
my ($val, $shift, $dir) = @_; |
275
|
6
|
|
|
|
|
25
|
$_[0] = $val + $shift * $dir; # return shifted value |
276
|
6
|
|
|
|
|
46
|
return undef; # success! |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
280
|
|
|
|
|
|
|
# Shift date/time string |
281
|
|
|
|
|
|
|
# Inputs: 0) date/time string, 1) shift string, 2) shift direction (+1 or -1), |
282
|
|
|
|
|
|
|
# or 0 or undef to take shift direction from sign of shift, |
283
|
|
|
|
|
|
|
# 3) reference to ShiftOffset hash (with Date, DateTime, Time, Timezone keys) |
284
|
|
|
|
|
|
|
# or 0) shift string (and operates on $_) |
285
|
|
|
|
|
|
|
# Returns: error string or undef on success and date/time string is updated |
286
|
|
|
|
|
|
|
sub ShiftTime($;$$$) |
287
|
|
|
|
|
|
|
{ |
288
|
62
|
|
|
62
|
0
|
197
|
my ($val, $shift, $dir, $shiftOffset); |
289
|
62
|
|
|
|
|
0
|
my (@time, @shift, @toTime, $mode, $needShiftOffset, $dec); |
290
|
|
|
|
|
|
|
|
291
|
62
|
50
|
|
|
|
167
|
if (@_ == 1) { # single argument form of ShiftTime()? |
292
|
0
|
|
|
|
|
0
|
$val = $_; |
293
|
0
|
|
|
|
|
0
|
$shift = $_[0]; |
294
|
|
|
|
|
|
|
} else { |
295
|
62
|
|
|
|
|
492
|
($val, $shift, $dir, $shiftOffset) = @_; |
296
|
|
|
|
|
|
|
} |
297
|
62
|
0
|
0
|
|
|
150
|
$dir or $dir = ($shift =~ s/^(\+|-)// and $1 eq '-') ? -1 : 1; |
|
|
50
|
|
|
|
|
|
298
|
|
|
|
|
|
|
# |
299
|
|
|
|
|
|
|
# figure out what we are dealing with (time, date or date/time) |
300
|
|
|
|
|
|
|
# |
301
|
62
|
50
|
|
|
|
164
|
SplitTime($val, \@time) or return "Invalid time string ($val)"; |
302
|
62
|
50
|
|
|
|
146
|
if (defined $time[0]) { |
|
|
0
|
|
|
|
|
|
303
|
62
|
50
|
|
|
|
160
|
return "Can't shift from year 0000" if $time[0] eq '0000'; |
304
|
62
|
100
|
|
|
|
153
|
$mode = defined $time[3] ? 'DateTime' : 'Date'; |
305
|
|
|
|
|
|
|
} elsif (defined $time[3]) { |
306
|
0
|
|
|
|
|
0
|
$mode = 'Time'; |
307
|
|
|
|
|
|
|
} else { |
308
|
0
|
|
|
|
|
0
|
$mode = ''; |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
# get number of digits after the seconds decimal point |
311
|
62
|
100
|
100
|
|
|
331
|
if (defined $time[5] and $time[5] =~ /\.(\d+)/) { |
312
|
47
|
|
|
|
|
107
|
$dec = length($1); |
313
|
|
|
|
|
|
|
} else { |
314
|
15
|
|
|
|
|
31
|
$dec = 0; |
315
|
|
|
|
|
|
|
} |
316
|
62
|
100
|
|
|
|
140
|
if ($shiftOffset) { |
317
|
15
|
100
|
|
|
|
44
|
$needShiftOffset = 1 unless defined $$shiftOffset{$mode}; |
318
|
15
|
100
|
66
|
|
|
60
|
$needShiftOffset = 1 if defined $time[6] and not defined $$shiftOffset{Timezone}; |
319
|
|
|
|
|
|
|
} else { |
320
|
47
|
|
|
|
|
70
|
$needShiftOffset = 1; |
321
|
|
|
|
|
|
|
} |
322
|
62
|
100
|
|
|
|
137
|
if ($needShiftOffset) { |
323
|
|
|
|
|
|
|
# |
324
|
|
|
|
|
|
|
# apply date/time shift the hard way |
325
|
|
|
|
|
|
|
# |
326
|
56
|
50
|
|
|
|
137
|
SplitTime($shift, \@shift, \@time) or return "Invalid shift string ($shift)"; |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
# change 'Z' timezone to '+00:00' only if necessary |
329
|
56
|
50
|
66
|
|
|
235
|
if (@shift > 6 and @time <= 6) { |
330
|
0
|
0
|
|
|
|
0
|
$time[6] = $time[7] = 0 if $val =~ s/Z$/\+00:00/; |
331
|
|
|
|
|
|
|
} |
332
|
56
|
|
|
|
|
100
|
my $rndDiff; |
333
|
56
|
|
|
|
|
162
|
my $err = ShiftComponents(\@time, \@shift, $dir, \@toTime, $dec, \$rndDiff); |
334
|
56
|
50
|
|
|
|
127
|
$err and return $err; |
335
|
|
|
|
|
|
|
# |
336
|
|
|
|
|
|
|
# calculate and save the shift offsets for next time |
337
|
|
|
|
|
|
|
# |
338
|
56
|
100
|
|
|
|
132
|
if ($shiftOffset) { |
339
|
9
|
50
|
33
|
|
|
65
|
if (defined $time[0] or defined $time[3]) { |
340
|
9
|
|
|
|
|
46
|
my @tm1 = (0, 0, 0, 1, 0, 2000); |
341
|
9
|
|
|
|
|
29
|
my @tm2 = (0, 0, 0, 1, 0, 2000); |
342
|
9
|
50
|
|
|
|
43
|
if (defined $time[0]) { |
343
|
9
|
|
|
|
|
57
|
@tm1[3..5] = reverse @time[0..2]; |
344
|
9
|
|
|
|
|
39
|
@tm2[3..5] = reverse @toTime[0..2]; |
345
|
9
|
|
|
|
|
22
|
--$tm1[4]; # month should start from 0 |
346
|
9
|
|
|
|
|
27
|
--$tm2[4]; |
347
|
|
|
|
|
|
|
} |
348
|
9
|
|
|
|
|
22
|
my $diff = 0; |
349
|
9
|
100
|
|
|
|
38
|
if (defined $time[3]) { |
350
|
7
|
|
|
|
|
41
|
@tm1[0..2] = reverse @time[3..5]; |
351
|
7
|
|
|
|
|
26
|
@tm2[0..2] = reverse @toTime[3..5]; |
352
|
|
|
|
|
|
|
# handle fractional seconds separately |
353
|
7
|
|
|
|
|
20
|
$diff = $tm2[0] - int($tm2[0]) - ($tm1[0] - int($tm1[0])); |
354
|
7
|
50
|
|
|
|
19
|
$diff += $rndDiff if defined $rndDiff; # un-do rounding |
355
|
7
|
|
|
|
|
18
|
$tm1[0] = int($tm1[0]); |
356
|
7
|
|
|
|
|
13
|
$tm2[0] = int($tm2[0]); |
357
|
|
|
|
|
|
|
} |
358
|
9
|
|
|
|
|
890
|
eval q{ |
359
|
|
|
|
|
|
|
require Time::Local; |
360
|
|
|
|
|
|
|
$diff += Time::Local::timegm(@tm2) - Time::Local::timegm(@tm1); |
361
|
|
|
|
|
|
|
}; |
362
|
|
|
|
|
|
|
# not a problem if we failed here since we'll just try again next time, |
363
|
|
|
|
|
|
|
# so don't return error message |
364
|
9
|
50
|
|
|
|
766
|
unless (@$) { |
365
|
9
|
|
|
|
|
20
|
my $mode; |
366
|
9
|
50
|
|
|
|
31
|
if (defined $time[0]) { |
367
|
9
|
100
|
|
|
|
39
|
$mode = defined $time[3] ? 'DateTime' : 'Date'; |
368
|
|
|
|
|
|
|
} else { |
369
|
0
|
|
|
|
|
0
|
$mode = 'Time'; |
370
|
|
|
|
|
|
|
} |
371
|
9
|
|
|
|
|
45
|
$$shiftOffset{$mode} = $diff; |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
} |
374
|
9
|
100
|
|
|
|
29
|
if (defined $time[6]) { |
375
|
3
|
|
|
|
|
14
|
$$shiftOffset{Timezone} = ($toTime[6] - $time[6]) * 60 + |
376
|
|
|
|
|
|
|
$toTime[7] - $time[7]; |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
} else { |
381
|
|
|
|
|
|
|
# |
382
|
|
|
|
|
|
|
# apply shift from previously calculated offsets |
383
|
|
|
|
|
|
|
# |
384
|
6
|
50
|
33
|
|
|
22
|
if ($$shiftOffset{Timezone} and @time <= 6) { |
385
|
|
|
|
|
|
|
# change 'Z' timezone to '+00:00' only if necessary |
386
|
0
|
0
|
|
|
|
0
|
$time[6] = $time[7] = 0 if $val =~ s/Z$/\+00:00/; |
387
|
|
|
|
|
|
|
} |
388
|
|
|
|
|
|
|
# apply the previous date/time shift if necessary |
389
|
6
|
50
|
|
|
|
11
|
if ($mode) { |
390
|
6
|
|
|
|
|
15
|
my @tm = (0, 0, 0, 1, 0, 2000); |
391
|
6
|
50
|
|
|
|
12
|
if (defined $time[0]) { |
392
|
6
|
|
|
|
|
19
|
@tm[3..5] = reverse @time[0..2]; |
393
|
6
|
|
|
|
|
15
|
--$tm[4]; # month should start from 0 |
394
|
|
|
|
|
|
|
} |
395
|
6
|
50
|
|
|
|
21
|
@tm[0..2] = reverse @time[3..5] if defined $time[3]; |
396
|
|
|
|
|
|
|
# save fractional seconds |
397
|
6
|
|
|
|
|
13
|
my $frac = $tm[0] - int($tm[0]); |
398
|
6
|
|
|
|
|
9
|
$tm[0] = int($tm[0]); |
399
|
6
|
|
|
|
|
10
|
my $tm; |
400
|
6
|
|
|
|
|
474
|
eval q{ |
401
|
|
|
|
|
|
|
require Time::Local; |
402
|
|
|
|
|
|
|
$tm = Time::Local::timegm(@tm) + $frac; |
403
|
|
|
|
|
|
|
}; |
404
|
6
|
50
|
|
|
|
265
|
$@ and return CleanWarning($@); |
405
|
6
|
|
|
|
|
14
|
$tm += $$shiftOffset{$mode}; # apply the shift |
406
|
6
|
50
|
|
|
|
12
|
$tm < 0 and return 'Shift results in negative time'; |
407
|
|
|
|
|
|
|
# save fractional seconds in shifted time |
408
|
6
|
|
|
|
|
11
|
$frac = $tm - int($tm); |
409
|
6
|
50
|
|
|
|
10
|
if ($frac) { |
410
|
0
|
|
|
|
|
0
|
$tm = int($tm); |
411
|
|
|
|
|
|
|
# must account for any rounding that could occur |
412
|
0
|
0
|
|
|
|
0
|
$frac + 0.5 * 10 ** (-$dec) >= 1 and ++$tm, $frac = 0; |
413
|
|
|
|
|
|
|
} |
414
|
6
|
|
|
|
|
38
|
@tm = gmtime($tm); |
415
|
6
|
|
|
|
|
17
|
@toTime = reverse @tm[0..5]; |
416
|
6
|
|
|
|
|
16
|
$toTime[0] += 1900; |
417
|
6
|
|
|
|
|
9
|
++$toTime[1]; |
418
|
6
|
|
|
|
|
12
|
$toTime[5] += $frac; # add the fractional seconds back in |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
# apply the previous timezone shift if necessary |
421
|
6
|
50
|
|
|
|
21
|
if (defined $time[6]) { |
422
|
0
|
|
|
|
|
0
|
my $m = $time[6] * 60 + $time[7]; |
423
|
0
|
|
|
|
|
0
|
$m += $$shiftOffset{Timezone}; |
424
|
0
|
|
|
|
|
0
|
$m += 0.5 * ($m <=> 0); # avoid round-off errors |
425
|
0
|
|
|
|
|
0
|
$toTime[6] = int($m / 60); |
426
|
0
|
|
|
|
|
0
|
$toTime[7] = int($m - $toTime[6] * 60); |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
# |
430
|
|
|
|
|
|
|
# insert shifted time components back into original string |
431
|
|
|
|
|
|
|
# |
432
|
62
|
|
|
|
|
99
|
my $i; |
433
|
62
|
|
|
|
|
157
|
for ($i=0; $i<@toTime; ++$i) { |
434
|
416
|
50
|
33
|
|
|
1333
|
next unless defined $time[$i] and defined $toTime[$i]; |
435
|
416
|
|
|
|
|
607
|
my ($v, $d, $s); |
436
|
416
|
100
|
|
|
|
729
|
if ($i != 6) { # not timezone hours |
437
|
366
|
50
|
|
|
|
1323
|
last unless $val =~ /((?=\d|\.\d)\d*(\.\d*)?)/g; |
438
|
366
|
100
|
|
|
|
1013
|
next if $toTime[$i] == $time[$i]; |
439
|
133
|
|
|
|
|
273
|
$v = $1; # value |
440
|
133
|
|
|
|
|
232
|
$d = $2; # decimal part of value |
441
|
133
|
|
|
|
|
200
|
$s = ''; # no sign |
442
|
|
|
|
|
|
|
} else { |
443
|
50
|
50
|
33
|
|
|
209
|
last if $time[$i] == $toTime[$i] and $time[$i+1] == $toTime[$i+1]; |
444
|
0
|
0
|
|
|
|
0
|
last unless $val =~ /((?:\+|-)(?=\d|\.\d)\d*(\.\d*)?)/g; |
445
|
0
|
|
|
|
|
0
|
$v = $1; |
446
|
0
|
|
|
|
|
0
|
$d = $2; |
447
|
0
|
0
|
0
|
|
|
0
|
if ($toTime[6] >= 0 and $toTime[7] >= 0) { |
448
|
0
|
|
|
|
|
0
|
$s = '+'; |
449
|
|
|
|
|
|
|
} else { |
450
|
0
|
|
|
|
|
0
|
$s = '-'; |
451
|
0
|
|
|
|
|
0
|
$toTime[6] = -$toTime[6]; |
452
|
0
|
|
|
|
|
0
|
$toTime[7] = -$toTime[7]; |
453
|
|
|
|
|
|
|
} |
454
|
|
|
|
|
|
|
} |
455
|
133
|
|
|
|
|
210
|
my $nv = $toTime[$i]; |
456
|
133
|
|
|
|
|
191
|
my $pos = pos $val; |
457
|
133
|
|
|
|
|
194
|
my $len = length $v; |
458
|
133
|
|
|
|
|
216
|
my $sig = $len - length $s; |
459
|
133
|
50
|
|
|
|
227
|
my $dec = $d ? length($d) - 1 : 0; |
460
|
133
|
50
|
|
|
|
504
|
my $newNum = sprintf($dec ? "$s%0$sig.${dec}f" : "$s%0${sig}d", $nv); |
461
|
133
|
|
|
|
|
335
|
substr($val, $pos - $len, $len) = $newNum; |
462
|
133
|
|
|
|
|
532
|
pos($val) = $pos + length($newNum) - $len; |
463
|
|
|
|
|
|
|
} |
464
|
62
|
50
|
|
|
|
154
|
if (@_ == 1) { |
465
|
0
|
|
|
|
|
0
|
$_ = $val; # set $_ to the returned value |
466
|
|
|
|
|
|
|
} else { |
467
|
62
|
|
|
|
|
135
|
$_[0] = $val; # return shifted value |
468
|
|
|
|
|
|
|
} |
469
|
62
|
|
|
|
|
320
|
return undef; # success! |
470
|
|
|
|
|
|
|
} |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
1; # end |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
__END__ |