line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
1
|
|
|
1
|
|
806
|
use Time::Local;
|
|
1
|
|
|
|
|
1767
|
|
|
1
|
|
|
|
|
2765
|
|
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
sub ABS
|
4
|
|
|
|
|
|
|
{
|
5
|
0
|
|
|
0
|
0
|
0
|
return abs(shift);
|
6
|
|
|
|
|
|
|
}
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
sub ADD_MONTHS
|
9
|
|
|
|
|
|
|
{
|
10
|
0
|
|
|
0
|
0
|
0
|
my ($d, $n) = @_;
|
11
|
0
|
|
|
|
|
0
|
my @timestuff = localtime($d);
|
12
|
0
|
|
|
|
|
0
|
my ($mday) = $timestuff[3];
|
13
|
0
|
|
|
|
|
0
|
$d += (30*86400)*$n;
|
14
|
0
|
|
|
|
|
0
|
@timestuff = localtime($d);
|
15
|
0
|
|
|
|
|
0
|
my $thisdate = $timestuff[5] + 1900;
|
16
|
0
|
0
|
|
|
|
0
|
$thisdate .= '0' if ($timestuff[4] < 9);
|
17
|
0
|
|
|
|
|
0
|
$thisdate .= $timestuff[4] + 1;
|
18
|
0
|
0
|
|
|
|
0
|
$thisdate .= '0' if ($mday < 10);
|
19
|
0
|
|
|
|
|
0
|
$thisdate .= $mday;
|
20
|
0
|
|
|
|
|
0
|
my $xx = timelocal(0,0,0,substr($thisdate,6,2),
|
21
|
|
|
|
|
|
|
(substr($thisdate,4,2)-1),substr($thisdate,0,4),0,0,0);
|
22
|
0
|
|
|
|
|
0
|
return $xx;
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
}
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub ASCII
|
27
|
|
|
|
|
|
|
{
|
28
|
0
|
|
|
0
|
0
|
0
|
return ord(shift);
|
29
|
|
|
|
|
|
|
}
|
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
sub CEIL
|
32
|
|
|
|
|
|
|
{
|
33
|
0
|
|
|
0
|
0
|
0
|
my $n = shift;
|
34
|
0
|
0
|
|
|
|
0
|
return int($n) + 1 if ($n > int($n));
|
35
|
0
|
|
|
|
|
0
|
return int($n);
|
36
|
|
|
|
|
|
|
}
|
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
sub CHR
|
39
|
|
|
|
|
|
|
{
|
40
|
0
|
|
|
0
|
0
|
0
|
return chr(shift);
|
41
|
|
|
|
|
|
|
}
|
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub CONCAT
|
44
|
|
|
|
|
|
|
{
|
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
#@_ = &chkcolumnparms(@_);
|
47
|
|
|
|
|
|
|
#return $_[0].$_[1];
|
48
|
4
|
|
|
4
|
0
|
43
|
return join('',@_);
|
49
|
|
|
|
|
|
|
}
|
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub COS
|
52
|
|
|
|
|
|
|
{
|
53
|
0
|
|
|
0
|
0
|
0
|
return cos(shift);
|
54
|
|
|
|
|
|
|
}
|
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
sub CURDATE
|
57
|
|
|
|
|
|
|
{
|
58
|
0
|
|
0
|
0
|
0
|
0
|
my $fmt = shift || 'yyyy-mm-dd';
|
59
|
0
|
|
|
|
|
0
|
return TO_CHAR(SYSTIME, $fmt)
|
60
|
|
|
|
|
|
|
}
|
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
sub DAYS_BETWEEN #SPRITE-ONLY FUNCTION.
|
63
|
|
|
|
|
|
|
{
|
64
|
0
|
|
|
0
|
0
|
0
|
my ($d1, $d2) = @_;
|
65
|
0
|
|
|
|
|
0
|
my ($secbtn) = abs($d2 - $d1);
|
66
|
0
|
|
|
|
|
0
|
return $secbtn / 86400;
|
67
|
|
|
|
|
|
|
}
|
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub EXP
|
70
|
|
|
|
|
|
|
{
|
71
|
0
|
|
|
0
|
0
|
0
|
return 2.71828183 ** shift;
|
72
|
|
|
|
|
|
|
}
|
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
sub FLOOR
|
75
|
|
|
|
|
|
|
{
|
76
|
0
|
|
|
0
|
0
|
0
|
my $n = shift;
|
77
|
0
|
0
|
0
|
|
|
0
|
return int($n) - 1 if ($n < 0 && $n < int($n));
|
78
|
0
|
|
|
|
|
0
|
return int($n);
|
79
|
|
|
|
|
|
|
}
|
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub INITCAP
|
82
|
|
|
|
|
|
|
{
|
83
|
0
|
|
|
0
|
0
|
0
|
my ($s) = shift;
|
84
|
0
|
|
|
|
|
0
|
$s =~ s/\b(\w)(\w*)/\U$1\L$2\E/g;
|
85
|
0
|
|
|
|
|
0
|
return $s;
|
86
|
|
|
|
|
|
|
}
|
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub INSTR
|
89
|
|
|
|
|
|
|
{
|
90
|
0
|
|
|
0
|
0
|
0
|
my ($s, $srch, $n, $m) = @_;
|
91
|
0
|
|
|
|
|
0
|
my $t = $n;
|
92
|
0
|
0
|
|
|
|
0
|
if ($n < 0)
|
93
|
|
|
|
|
|
|
{
|
94
|
0
|
|
|
|
|
0
|
$s = reverse($s);
|
95
|
0
|
|
|
|
|
0
|
$srch = reverse($srch);
|
96
|
0
|
|
|
|
|
0
|
$t = abs($n);
|
97
|
|
|
|
|
|
|
}
|
98
|
0
|
|
|
|
|
0
|
for (my $i=1;$i<=$m;$i++)
|
99
|
|
|
|
|
|
|
{
|
100
|
0
|
|
|
|
|
0
|
$t = index($s, $srch, $t) + 1;
|
101
|
0
|
0
|
|
|
|
0
|
return 0 if ($t < 0);
|
102
|
|
|
|
|
|
|
}
|
103
|
0
|
0
|
|
|
|
0
|
return length($s) - $t if ($n < 0);
|
104
|
0
|
|
|
|
|
0
|
return $t;
|
105
|
|
|
|
|
|
|
}
|
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub INSTRB
|
108
|
|
|
|
|
|
|
{
|
109
|
0
|
|
|
0
|
0
|
0
|
return INSTR(@_);
|
110
|
|
|
|
|
|
|
}
|
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
sub LAST_DAY
|
113
|
|
|
|
|
|
|
{
|
114
|
0
|
|
|
0
|
0
|
0
|
my ($t) = shift;
|
115
|
|
|
|
|
|
|
|
116
|
0
|
|
|
|
|
0
|
my @timestuff = localtime($t);
|
117
|
0
|
|
|
|
|
0
|
my @lastdate = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
|
118
|
0
|
|
|
|
|
0
|
my $thisdate = $timestuff[5] + 1900;
|
119
|
0
|
0
|
|
|
|
0
|
$thisdate .= '0' if ($timestuff[4] < 9);
|
120
|
0
|
|
|
|
|
0
|
$thisdate .= $timestuff[4] + 1;
|
121
|
|
|
|
|
|
|
#$thisdate .= '0' if ($timestuff[3] < 10);
|
122
|
|
|
|
|
|
|
#$thisdate .= $timestuff[3];
|
123
|
0
|
0
|
|
|
|
0
|
if ($timestuff[4] == 1)
|
124
|
|
|
|
|
|
|
{
|
125
|
0
|
0
|
|
|
|
0
|
if (!(($timestuff[5]+300) % 400))
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
126
|
|
|
|
|
|
|
{
|
127
|
0
|
|
|
|
|
0
|
$thisdate .= '29';
|
128
|
|
|
|
|
|
|
}
|
129
|
|
|
|
|
|
|
elsif (!($timestuff[5] % 100))
|
130
|
|
|
|
|
|
|
{
|
131
|
0
|
|
|
|
|
0
|
$thisdate .= '28';
|
132
|
|
|
|
|
|
|
}
|
133
|
|
|
|
|
|
|
elsif (!($timestuff[5] % 4))
|
134
|
|
|
|
|
|
|
{
|
135
|
0
|
|
|
|
|
0
|
$thisdate .= '29';
|
136
|
|
|
|
|
|
|
}
|
137
|
|
|
|
|
|
|
else
|
138
|
|
|
|
|
|
|
{
|
139
|
0
|
|
|
|
|
0
|
$thisdate .= '28';
|
140
|
|
|
|
|
|
|
}
|
141
|
|
|
|
|
|
|
}
|
142
|
|
|
|
|
|
|
else
|
143
|
|
|
|
|
|
|
{
|
144
|
0
|
|
|
|
|
0
|
$thisdate .= $lastdate[$timestuff[4]];
|
145
|
|
|
|
|
|
|
}
|
146
|
0
|
|
|
|
|
0
|
my $xx = timelocal(0,0,0,substr($thisdate,6,2),
|
147
|
|
|
|
|
|
|
(substr($thisdate,4,2)-1),substr($thisdate,0,4),0,0,0);
|
148
|
0
|
|
|
|
|
0
|
return $xx;
|
149
|
|
|
|
|
|
|
}
|
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
sub LENGTH
|
152
|
|
|
|
|
|
|
{
|
153
|
0
|
|
|
0
|
0
|
0
|
return length(shift);
|
154
|
|
|
|
|
|
|
}
|
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
sub LENGTHB
|
157
|
|
|
|
|
|
|
{
|
158
|
0
|
|
|
0
|
0
|
0
|
return length(shift);
|
159
|
|
|
|
|
|
|
}
|
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
sub LPAD
|
162
|
|
|
|
|
|
|
{
|
163
|
0
|
|
|
0
|
0
|
0
|
my ($s, $l, $p) = @_;
|
164
|
0
|
|
|
|
|
0
|
my $t = $p x $l;
|
165
|
0
|
|
|
|
|
0
|
return substr($t,0,($l-length($s))) . $s;
|
166
|
|
|
|
|
|
|
}
|
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
sub LTRIM
|
169
|
|
|
|
|
|
|
{
|
170
|
0
|
|
|
0
|
0
|
0
|
my ($x, $y) = @_;
|
171
|
0
|
|
|
|
|
0
|
$x =~ s/^[$y]+//;
|
172
|
0
|
|
|
|
|
0
|
return $x;
|
173
|
|
|
|
|
|
|
}
|
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
sub LOWER
|
176
|
|
|
|
|
|
|
{
|
177
|
|
|
|
|
|
|
#@_ = &chkcolumnparms(@_);
|
178
|
0
|
|
|
0
|
0
|
0
|
my ($s) = shift;
|
179
|
0
|
|
|
|
|
0
|
$s =~ tr/A-Z/a-z/;
|
180
|
0
|
|
|
|
|
0
|
return $s;
|
181
|
|
|
|
|
|
|
}
|
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
sub MOD
|
184
|
|
|
|
|
|
|
{
|
185
|
0
|
|
|
0
|
0
|
0
|
my ($m, $n) = @_;
|
186
|
0
|
0
|
|
|
|
0
|
return $m unless ($n);
|
187
|
0
|
|
|
|
|
0
|
return $m % $n;
|
188
|
|
|
|
|
|
|
}
|
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
sub MONTHS_BETWEEN #ASSUMES 30-DAY MONTHS - APPROXIMATES THE ORACLE FUNCTION!
|
191
|
|
|
|
|
|
|
{
|
192
|
0
|
|
|
0
|
0
|
0
|
my ($d1, $d2) = @_;
|
193
|
0
|
|
|
|
|
0
|
my ($secbtn) = abs($d2 - $d1);
|
194
|
0
|
|
|
|
|
0
|
return $secbtn / (30*86400);
|
195
|
|
|
|
|
|
|
}
|
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
sub NOW
|
198
|
|
|
|
|
|
|
{
|
199
|
0
|
|
0
|
0
|
0
|
0
|
my $fmt = shift || 'yyyy-mm-dd hh:mi:ss';
|
200
|
0
|
|
|
|
|
0
|
return TO_CHAR(SYSTIME, $fmt)
|
201
|
|
|
|
|
|
|
}
|
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
sub now
|
204
|
|
|
|
|
|
|
{
|
205
|
0
|
|
0
|
0
|
0
|
0
|
my $fmt = shift || 'yyyy-mm-dd hh:mi:ss';
|
206
|
0
|
|
|
|
|
0
|
return TO_CHAR(SYSTIME, $fmt)
|
207
|
|
|
|
|
|
|
}
|
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
sub NVL #CHGD. TO LAST LINE 20040325 TO MAKE WORK LIKE ORACLE!?
|
210
|
|
|
|
|
|
|
{
|
211
|
|
|
|
|
|
|
# my (@parms) = @_;
|
212
|
|
|
|
|
|
|
# my ($t);
|
213
|
|
|
|
|
|
|
# while ($#parms >= 0)
|
214
|
|
|
|
|
|
|
# {
|
215
|
|
|
|
|
|
|
# $t = shift(@parms);
|
216
|
|
|
|
|
|
|
# return $t if (defined($t) && $t ne '');
|
217
|
|
|
|
|
|
|
# }
|
218
|
|
|
|
|
|
|
# return defined($t) ? $t : '';
|
219
|
0
|
0
|
|
0
|
0
|
0
|
return (length($_[0]) ? $_[0] : $_[1]);
|
220
|
|
|
|
|
|
|
}
|
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
sub POWER
|
223
|
|
|
|
|
|
|
{
|
224
|
0
|
|
|
0
|
0
|
0
|
return $_[0] ** $_[1];
|
225
|
|
|
|
|
|
|
}
|
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
sub REPLACE
|
228
|
|
|
|
|
|
|
{
|
229
|
0
|
|
|
0
|
0
|
0
|
my ($s, $x, $y) = (@_[0..2]);
|
230
|
0
|
0
|
|
|
|
0
|
if ($_[3] eq 'i')
|
231
|
|
|
|
|
|
|
{
|
232
|
0
|
|
|
|
|
0
|
$s =~ s/\Q$x\E/\Q$y\E/ig; #SPRITE EXTENSION, NOT SUPPORTED IN ORACLE!
|
233
|
|
|
|
|
|
|
}
|
234
|
|
|
|
|
|
|
else
|
235
|
|
|
|
|
|
|
{
|
236
|
0
|
|
|
|
|
0
|
$s =~ s/\Q$x\E/\Q$y\E/g;
|
237
|
|
|
|
|
|
|
}
|
238
|
0
|
|
|
|
|
0
|
return $s;
|
239
|
|
|
|
|
|
|
}
|
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
sub ROUND
|
242
|
|
|
|
|
|
|
{
|
243
|
0
|
|
|
0
|
0
|
0
|
my ($m, $n) = @_;
|
244
|
0
|
0
|
|
|
|
0
|
return sprintf("%.${n}f", $m) if ($n >= 0);
|
245
|
0
|
|
|
|
|
0
|
$m *= 10 ** $n;
|
246
|
0
|
|
|
|
|
0
|
return (1 * sprintf('%.0f', $m)) / (10 ** $n);
|
247
|
|
|
|
|
|
|
}
|
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
sub RPAD
|
250
|
|
|
|
|
|
|
{
|
251
|
0
|
|
|
0
|
0
|
0
|
my ($s, $l, $p) = @_;
|
252
|
0
|
|
|
|
|
0
|
while (length($s) < $l)
|
253
|
|
|
|
|
|
|
{
|
254
|
0
|
|
|
|
|
0
|
$s .= $p;
|
255
|
|
|
|
|
|
|
}
|
256
|
0
|
|
|
|
|
0
|
return substr($s, 0, $l);
|
257
|
|
|
|
|
|
|
}
|
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
sub RTRIM
|
260
|
|
|
|
|
|
|
{
|
261
|
0
|
|
|
0
|
0
|
0
|
my ($x, $y) = @_;
|
262
|
0
|
|
|
|
|
0
|
$x =~ s/[$y]+$//;
|
263
|
0
|
|
|
|
|
0
|
return $x;
|
264
|
|
|
|
|
|
|
}
|
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
sub SIGN
|
267
|
|
|
|
|
|
|
{
|
268
|
0
|
0
|
|
0
|
0
|
0
|
return -1 if ($_[0] < 0);
|
269
|
0
|
0
|
|
|
|
0
|
return 0 unless ($_[0]);
|
270
|
0
|
|
|
|
|
0
|
return 1;
|
271
|
|
|
|
|
|
|
}
|
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
sub SIN
|
274
|
|
|
|
|
|
|
{
|
275
|
0
|
|
|
0
|
0
|
0
|
return sin(shift);
|
276
|
|
|
|
|
|
|
}
|
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
sub SQRT
|
279
|
|
|
|
|
|
|
{
|
280
|
0
|
|
|
0
|
0
|
0
|
return sqrt(shift);
|
281
|
|
|
|
|
|
|
}
|
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
sub SUBSTR
|
284
|
|
|
|
|
|
|
{
|
285
|
|
|
|
|
|
|
#@_ = &chkcolumnparms(@_);
|
286
|
0
|
|
|
0
|
0
|
0
|
my ($s) = shift;
|
287
|
0
|
|
|
|
|
0
|
my ($p) = shift;
|
288
|
|
|
|
|
|
|
#($s, $p) = &chkcolumnparms(@_);
|
289
|
|
|
|
|
|
|
|
290
|
0
|
0
|
|
|
|
0
|
return '' unless ($p);
|
291
|
|
|
|
|
|
|
|
292
|
0
|
0
|
|
|
|
0
|
--$p if ($p > 0);
|
293
|
|
|
|
|
|
|
|
294
|
0
|
|
|
|
|
0
|
my ($l) = shift;
|
295
|
0
|
0
|
|
|
|
0
|
return (substr($s, $p)) unless ($l);
|
296
|
0
|
|
|
|
|
0
|
return substr($s, $p, $l);
|
297
|
|
|
|
|
|
|
}
|
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
sub SUBSTRB
|
300
|
|
|
|
|
|
|
{
|
301
|
0
|
|
|
0
|
0
|
0
|
return SUBSTR(@_);
|
302
|
|
|
|
|
|
|
}
|
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
sub TO_CHAR
|
305
|
|
|
|
|
|
|
{
|
306
|
1
|
|
|
1
|
0
|
2920
|
do 'to_char.pl';
|
307
|
1
|
50
|
|
|
|
6
|
if ($err =~ /^Invalid/)
|
308
|
|
|
|
|
|
|
{
|
309
|
0
|
|
|
|
|
0
|
$errdetails = $err;
|
310
|
0
|
|
|
|
|
0
|
$rtnTime = '';
|
311
|
0
|
|
|
|
|
0
|
$self->display_error(-503);
|
312
|
|
|
|
|
|
|
}
|
313
|
1
|
|
|
|
|
4
|
return $rtnTime;
|
314
|
|
|
|
|
|
|
}
|
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
sub TO_DATE
|
317
|
|
|
|
|
|
|
{
|
318
|
0
|
|
|
0
|
0
|
|
do 'to_date.pl';
|
319
|
0
|
0
|
|
|
|
|
if ($err =~ /^Invalid/)
|
320
|
|
|
|
|
|
|
{
|
321
|
0
|
|
|
|
|
|
$errdetails = $err;
|
322
|
0
|
|
|
|
|
|
$rtnTime = '';
|
323
|
0
|
|
|
|
|
|
$self->display_error(-503);
|
324
|
|
|
|
|
|
|
}
|
325
|
0
|
|
|
|
|
|
return $rtnTime;
|
326
|
|
|
|
|
|
|
}
|
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
sub TO_NUMBER
|
329
|
|
|
|
|
|
|
{
|
330
|
0
|
|
|
0
|
0
|
|
$rtnTime = shift;
|
331
|
0
|
|
|
|
|
|
my $fmt = shift;
|
332
|
|
|
|
|
|
|
|
333
|
0
|
|
|
|
|
|
my $fmtstr = 'f';
|
334
|
0
|
0
|
|
|
|
|
$fmtstr = $1 if ($rtnTime =~ s/(e)eee//i);
|
335
|
0
|
|
|
|
|
|
$rtnTime =~ s/[^\d\.\+\-Vv]//g;
|
336
|
0
|
|
|
|
|
|
my $dec = 0;
|
337
|
0
|
0
|
|
|
|
|
$dec = length($2) if ($fmt =~ /([\d\+\-]*)V(\d*)/);
|
338
|
|
|
|
|
|
|
#my ($dec) = length($2);
|
339
|
0
|
|
|
|
|
|
$rtnTime *= (10 ** $dec);
|
340
|
0
|
|
|
|
|
|
return sprintf('%.0f',$rtnTime); #ROUND IT.
|
341
|
0
|
|
|
|
|
|
return $rtnTime;
|
342
|
|
|
|
|
|
|
}
|
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
sub TRANSLATE
|
345
|
|
|
|
|
|
|
{
|
346
|
0
|
|
|
0
|
0
|
|
my ($s, $a, $b) = @_;
|
347
|
0
|
|
|
|
|
|
eval "\$s =~ tr/$a/$b/d";
|
348
|
0
|
|
|
|
|
|
return $s;
|
349
|
|
|
|
|
|
|
}
|
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
sub TRUNC
|
352
|
|
|
|
|
|
|
{
|
353
|
0
|
|
|
0
|
0
|
|
my ($m, $n) = @_;
|
354
|
0
|
0
|
|
|
|
|
if ($n =~ /D/i)
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
355
|
|
|
|
|
|
|
{
|
356
|
0
|
|
|
|
|
|
my @timestuff = localtime($m);
|
357
|
0
|
|
|
|
|
|
my $thisdate = $timestuff[5] + 1900;
|
358
|
0
|
0
|
|
|
|
|
$thisdate .= '0' if ($timestuff[4] < 9);
|
359
|
0
|
|
|
|
|
|
$thisdate .= $timestuff[4] + 1;
|
360
|
0
|
0
|
|
|
|
|
$thisdate .= '0' if ($timestuff[3] < 10);
|
361
|
0
|
|
|
|
|
|
$thisdate .= $timestuff[3];
|
362
|
0
|
|
|
|
|
|
my $xx = timelocal(0,0,0,substr($thisdate,6,2),
|
363
|
|
|
|
|
|
|
(substr($thisdate,4,2)-1),substr($thisdate,0,4),0,0,0);
|
364
|
0
|
|
|
|
|
|
return $xx;
|
365
|
|
|
|
|
|
|
}
|
366
|
|
|
|
|
|
|
elsif ($n =~ /Y/i)
|
367
|
|
|
|
|
|
|
{
|
368
|
0
|
|
|
|
|
|
my @timestuff = localtime($m);
|
369
|
0
|
|
|
|
|
|
my $thisdate = $timestuff[5] + 1900;
|
370
|
0
|
|
|
|
|
|
my $xx = timelocal(0,0,0,1,0,$thisdate,0,0,0);
|
371
|
0
|
|
|
|
|
|
return $xx;
|
372
|
|
|
|
|
|
|
}
|
373
|
|
|
|
|
|
|
elsif ($n =~ /MI/i)
|
374
|
|
|
|
|
|
|
{
|
375
|
0
|
|
|
|
|
|
my @timestuff = localtime($m);
|
376
|
0
|
|
|
|
|
|
my $thisdate = $timestuff[5] + 1900;
|
377
|
0
|
0
|
|
|
|
|
$thisdate .= '0' if ($timestuff[4] < 9);
|
378
|
0
|
|
|
|
|
|
$thisdate .= $timestuff[4] + 1;
|
379
|
0
|
0
|
|
|
|
|
$thisdate .= '0' if ($timestuff[3] < 10);
|
380
|
0
|
|
|
|
|
|
$thisdate .= $timestuff[3];
|
381
|
0
|
0
|
|
|
|
|
$thisdate .= '0' if ($timestuff[2] < 10);
|
382
|
0
|
|
|
|
|
|
$thisdate .= $timestuff[2];
|
383
|
0
|
0
|
|
|
|
|
$thisdate .= '0' if ($timestuff[1] < 10);
|
384
|
0
|
|
|
|
|
|
$thisdate .= $timestuff[1];
|
385
|
0
|
|
|
|
|
|
my $xx = timelocal(0,substr($thisdate,10,2),substr($thisdate,8,2),substr($thisdate,6,2),
|
386
|
|
|
|
|
|
|
(substr($thisdate,4,2)-1),substr($thisdate,0,4),0,0,0);
|
387
|
0
|
|
|
|
|
|
return $xx;
|
388
|
|
|
|
|
|
|
}
|
389
|
|
|
|
|
|
|
elsif ($n =~ /M/i)
|
390
|
|
|
|
|
|
|
{
|
391
|
0
|
|
|
|
|
|
my @timestuff = localtime($m);
|
392
|
0
|
|
|
|
|
|
my $thisdate = $timestuff[5] + 1900;
|
393
|
0
|
0
|
|
|
|
|
$thisdate .= '0' if ($timestuff[4] < 9);
|
394
|
0
|
|
|
|
|
|
$thisdate .= $timestuff[4] + 1;
|
395
|
0
|
|
|
|
|
|
my $xx = timelocal(0,0,0,1,(substr($thisdate,4,2)-1),substr($thisdate,0,4),0,0,0);
|
396
|
0
|
|
|
|
|
|
return $xx;
|
397
|
|
|
|
|
|
|
}
|
398
|
|
|
|
|
|
|
elsif ($n =~ /H/i)
|
399
|
|
|
|
|
|
|
{
|
400
|
0
|
|
|
|
|
|
my @timestuff = localtime($m);
|
401
|
0
|
|
|
|
|
|
my $thisdate = $timestuff[5] + 1900;
|
402
|
0
|
0
|
|
|
|
|
$thisdate .= '0' if ($timestuff[4] < 9);
|
403
|
0
|
|
|
|
|
|
$thisdate .= $timestuff[4] + 1;
|
404
|
0
|
0
|
|
|
|
|
$thisdate .= '0' if ($timestuff[3] < 10);
|
405
|
0
|
|
|
|
|
|
$thisdate .= $timestuff[3];
|
406
|
0
|
0
|
|
|
|
|
$thisdate .= '0' if ($timestuff[2] < 10);
|
407
|
0
|
|
|
|
|
|
$thisdate .= $timestuff[2];
|
408
|
0
|
|
|
|
|
|
my $xx = timelocal(0,0,substr($thisdate,8,2),substr($thisdate,6,2),
|
409
|
|
|
|
|
|
|
(substr($thisdate,4,2)-1),substr($thisdate,0,4),0,0,0);
|
410
|
0
|
|
|
|
|
|
return $xx;
|
411
|
|
|
|
|
|
|
}
|
412
|
|
|
|
|
|
|
else
|
413
|
|
|
|
|
|
|
{
|
414
|
0
|
|
|
|
|
|
return int($m * (10 ** $n)) / (10 ** $n);
|
415
|
|
|
|
|
|
|
}
|
416
|
|
|
|
|
|
|
}
|
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
sub UPPER
|
419
|
|
|
|
|
|
|
{
|
420
|
0
|
|
|
0
|
0
|
|
my ($s) = shift;
|
421
|
0
|
|
|
|
|
|
$s =~ tr/a-z/A-Z/;
|
422
|
0
|
|
|
|
|
|
return $s;
|
423
|
|
|
|
|
|
|
}
|
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
sub WEEKS_BETWEEN #SPRITE-ONLY FUNCTION.
|
426
|
|
|
|
|
|
|
{
|
427
|
0
|
|
|
0
|
0
|
|
my ($d1, $d2) = @_;
|
428
|
0
|
|
|
|
|
|
my ($secbtn) = abs($d2 - $d1);
|
429
|
0
|
|
|
|
|
|
return $secbtn / (7*86400);
|
430
|
|
|
|
|
|
|
}
|
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
sub YEARS_BETWEEN #SPRITE-ONLY FUNCTION.
|
433
|
|
|
|
|
|
|
{
|
434
|
0
|
|
|
0
|
0
|
|
my ($d1, $d2) = @_;
|
435
|
0
|
|
|
|
|
|
my ($secbtn) = abs($d2 - $d1);
|
436
|
0
|
|
|
|
|
|
return $secbtn / (365.25*86400);
|
437
|
|
|
|
|
|
|
}
|
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
1
|