File Coverage

blib/lib/OraSpriteFns.pl
Criterion Covered Total %
statement 7 191 3.6
branch 1 80 1.2
condition 0 9 0.0
subroutine 3 44 6.8
pod 0 43 0.0
total 11 367 3.0


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