[Home] [Help]
PACKAGE BODY: APPS.HR_JP_STANDARD_PKG
Source
1 PACKAGE BODY hr_jp_standard_pkg AS
2 /* $Header: hrjpstnd.pkb 120.9 2006/12/05 07:44:51 ttagawa noship $ */
3 --
4 -- Constants
5 --
6 c_nls_lang CONSTANT VARCHAR2(92) := userenv('LANGUAGE');
7 c_cset CONSTANT VARCHAR2(30) := substr(c_nls_lang, instr(c_nls_lang, '.') + 1);
8 --
9 type t_hankaku is record(
10 upper_alphabet varchar2(255) := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ',
11 lower_alphabet varchar2(255) := 'abcdefghijklmnopqrstuvwxyz',
12 number varchar2(255) := '0123456789',
13 symbol varchar2(255) := ' !"#$%&''()*+,-./:;<=>?@[\]^_`{|}~',
14 kana varchar2(255) := sjhextochar('B6B7B8B9BABBBCBDBEBFC0C1C3C4C5C6C7C8C9CACBCCCDCECFD0D1D2D3D7D8D9DADBDCA6DD'),
15 upper_kana varchar2(255) := sjhextochar('B1B2B3B4B5D4D5D6C2'),
16 lower_kana varchar2(255) := sjhextochar('A7A8A9AAABACADAEAF'),
17 voiced_kana varchar2(255) := sjhextochar('B3DEB6DEB7DEB8DEB9DEBADEBBDEBCDEBDDEBEDEBFDEC0DEC1DEC2DEC3DEC4DECADECBDECCDECDDECEDECADFCBDFCCDFCDDFCEDF'),
18 jp_symbol varchar2(255) := sjhextochar('A1A2A3A4A5B0DEDF'));
19 type t_zenkaku is record(
20 upper_alphabet varchar2(255) := sjhextochar('8260826182628263826482658266826782688269826A826B826C826D826E826F8270827182728273827482758276827782788279'),
21 lower_alphabet varchar2(255) := sjhextochar('828182828283828482858286828782888289828A828B828C828D828E828F8290829182928293829482958296829782988299829A'),
22 number varchar2(255) := sjhextochar('824F825082518252825382548255825682578258'),
23 symbol varchar2(255) := sjhextochar('814081498168819481908193819581668169816A8196817B8143817C8144815E8146814781838181818481488197816D818F816E814F8151814D816F816281708150'),
24 kana varchar2(255) := sjhextochar('834A834C834E83508352835483568358835A835C835E8360836583678369836A836B836C836D836E837183748377837A837D837E8380838183828389838A838B838C838D838F83928393'),
25 upper_kana varchar2(255) := sjhextochar('834183438345834783498384838683888363'),
26 lower_kana varchar2(255) := sjhextochar('834083428344834683488383838583878362'),
27 voiced_kana varchar2(255) := sjhextochar('8394834B834D834F83518353835583578359835B835D835F8361836483668368836F837283758378837B8370837383768379837C'),
28 jp_symbol varchar2(255) := sjhextochar('81428175817681418145815B814A814B'));
29 l_hankaku_dummy t_hankaku;
30 l_zenkaku_dummy t_zenkaku;
31 c_hankaku constant t_hankaku := l_hankaku_dummy;
32 c_zenkaku constant t_zenkaku := l_zenkaku_dummy;
33 -- |---------------------------------------------------------------------------|
34 -- |-------------------------------< hextochar >-------------------------------|
35 -- |---------------------------------------------------------------------------|
36 -- This function returns converted character in DB character set from
37 -- hexadecimal value(p_src) in p_src_cset character set as source.
38 -- When p_src_cset is invalid or NULL, VALUE_ERROR is raised.
39 --
40 FUNCTION hextochar(
41 p_src IN VARCHAR2,
42 p_src_cset IN VARCHAR2) RETURN VARCHAR2
43 IS
44 l_raw RAW(2000);
45 l_src_lang VARCHAR2(91);
46 BEGIN
47 --
48 -- utl_raw.convert fails when l_raw is null.
49 --
50 if p_src is NULL then
51 return NULL;
52 else
53 --
54 -- Convert raw value to DB character set and return value with casted to varchar2.
55 --
56 l_raw := hextoraw(p_src);
57 l_src_lang := 'AMERICAN_AMERICA.' || p_src_cset;
58 return utl_raw.cast_to_varchar2(utl_raw.convert(l_raw, c_nls_lang, l_src_lang));
59 end if;
60 END hextochar;
61 -- |---------------------------------------------------------------------------|
62 -- |------------------------------< sjhextochar >------------------------------|
63 -- |---------------------------------------------------------------------------|
64 -- This function is wrapper of hextochar function with hexadicimal in SJIS.
65 --
66 FUNCTION sjhextochar(p_src IN VARCHAR2) RETURN VARCHAR2
67 IS
68 BEGIN
69 return hextochar(p_src, 'JA16SJIS');
70 END sjhextochar;
71 -- |---------------------------------------------------------------------------|
72 -- |-------------------------------< chartohex >-------------------------------|
73 -- |---------------------------------------------------------------------------|
74 -- This function returns converted character in destination character set
75 -- (p_dest_cset) from character(p_src) in DB character set as source.
76 -- When p_dest_cset is invalid or NULL, VALUE_ERROR is raised.
77 --
78 FUNCTION chartohex(
79 p_src IN VARCHAR2,
80 p_dest_cset IN VARCHAR2) RETURN VARCHAR2
81 IS
82 l_raw RAW(2000);
83 l_dest_lang VARCHAR2(91);
84 BEGIN
85 --
86 -- utl_raw.convert fails when l_raw is null.
87 --
88 if p_src is NULL then
89 return NULL;
90 else
91 --
92 -- Convert raw value to DB character set and return value with casted to varchar2.
93 --
94 l_raw := utl_raw.cast_to_raw(p_src);
95 l_dest_lang := 'AMERICAN_AMERICA.' || p_dest_cset;
96 return rawtohex(utl_raw.convert(l_raw, l_dest_lang, c_nls_lang));
97 end if;
98 END chartohex;
99 -- |---------------------------------------------------------------------------|
100 -- |------------------------------< chartosjhex >------------------------------|
101 -- |---------------------------------------------------------------------------|
102 -- This function is wrapper of chartohex function with hexadicimal in SJIS.
103 --
104 FUNCTION chartosjhex(p_src IN VARCHAR2) RETURN VARCHAR2
105 IS
106 BEGIN
107 return chartohex(p_src, 'JA16SJIS');
108 END chartosjhex;
109 -- |---------------------------------------------------------------------------|
110 -- |------------------------------< translate2 >-------------------------------|
111 -- |---------------------------------------------------------------------------|
112 function translate2(
113 p_str in varchar2,
114 p_old_chrs in varchar2,
115 p_new_chrs in varchar2 default null) return varchar2
116 is
117 l_str varchar2(32767);
118 l_new_chrs varchar2(32767);
119 begin
120 if p_str is not null and p_old_chrs is not null then
121 if p_new_chrs is null then
122 l_new_chrs := substr(p_old_chrs, 1, 1);
123 --
124 if l_new_chrs <> p_old_chrs then
125 l_str := translate(p_str, p_old_chrs, l_new_chrs);
126 --
127 if l_str is not null then
128 l_str := replace(l_str, l_new_chrs);
129 end if;
130 else
131 l_str := replace(p_str, l_new_chrs);
132 end if;
133 else
134 l_str := translate(p_str, p_old_chrs, p_new_chrs);
135 end if;
136 --
137 return l_str;
138 else
139 return p_str;
140 end if;
141 end translate2;
142 -- |---------------------------------------------------------------------------|
143 -- |---------------------------------< strip >---------------------------------|
144 -- |---------------------------------------------------------------------------|
145 function strip(
146 p_str in varchar2,
147 p_chrs in varchar2,
148 p_replacement_chr in varchar2 default null) return varchar2
149 is
150 l_str varchar2(32767);
151 l_old_chrs varchar2(32767);
152 --
153 function new_replacement_chrs(p_old_chrs in varchar2) return varchar2
154 is
155 l_new_chrs varchar2(32767);
156 begin
157 if p_old_chrs is not null and p_replacement_chr is not null then
158 if length(p_replacement_chr) > 1 then
159 fnd_message.set_name('PER', 'HR_JP_INVALID_REPLACEMENT_CHR');
160 fnd_message.set_token('REPLACEMENT_CHR', p_replacement_chr);
161 fnd_message.raise_error;
162 end if;
163 --
164 for i in 1..length(p_old_chrs) loop
165 l_new_chrs := l_new_chrs || p_replacement_chr;
166 end loop;
167 end if;
168 --
169 return l_new_chrs;
170 end new_replacement_chrs;
171 begin
172 if p_str is not null then
173 if p_chrs is not null then
174 l_old_chrs := translate2(p_str, p_chrs);
175 --
176 if l_old_chrs is not null then
177 l_str := translate2(p_str, l_old_chrs, new_replacement_chrs(l_old_chrs));
178 else
179 l_str := p_str;
180 end if;
181 else
182 if p_replacement_chr is not null then
183 l_str := new_replacement_chrs(p_str);
184 end if;
185 end if;
186 end if;
187 --
188 return l_str;
189 end strip;
190 -- |---------------------------------------------------------------------------|
191 -- |---------------------------< recursive_replace >---------------------------|
192 -- |---------------------------------------------------------------------------|
193 --
194 -- Pay attention not to go into infinite loop
195 --
196 function recursive_replace(
197 p_str in varchar2,
198 p_old_str in varchar2,
199 p_new_str in varchar2 default null) return varchar2
200 is
201 l_str varchar2(32767);
202 l_str2 varchar2(32767);
203 begin
204 if p_str is not null and p_old_str is not null then
205 l_str2 := p_str;
206 loop
207 l_str := replace(l_str2, p_old_str, p_new_str);
208 if l_str is null or l_str = l_str2 then
209 exit;
210 else
211 l_str2 := l_str;
212 end if;
213 end loop;
214 --
215 return l_str;
216 else
217 return p_str;
218 end if;
219 end recursive_replace;
220 -- |---------------------------------------------------------------------------|
221 -- |--------------------------------< round2 >---------------------------------|
222 -- |---------------------------------------------------------------------------|
223 function round2(
224 p_num in number,
225 p_places in number default 0) return number
226 is
227 l_num number;
228 l_pow number;
229 begin
230 if p_num is not null and p_places is not null then
231 l_pow := power(10, trunc(p_places));
232 --
233 if p_num >= 0 then
234 l_num := ceil(p_num * l_pow - 0.5) / l_pow;
235 else
236 l_num := floor(p_num * l_pow + 0.5) / l_pow;
237 end if;
238 --
239 return l_num;
240 else
241 return null;
242 end if;
243 end round2;
244 -- |---------------------------------------------------------------------------|
245 -- |------------------------------< is_integer >-------------------------------|
246 -- |---------------------------------------------------------------------------|
247 function is_integer(p_num in number) return varchar2
248 is
249 l_is_integer varchar2(1) := 'Y';
250 begin
251 if p_num is not null then
252 if floor(p_num) <> p_num then
253 l_is_integer := 'N';
254 end if;
255 end if;
256 --
257 return l_is_integer;
258 end is_integer;
259 -- |---------------------------------------------------------------------------|
260 -- |------------------------------< is_hankaku >-------------------------------|
261 -- |---------------------------------------------------------------------------|
262 function is_hankaku(p_chr in varchar2) return boolean
263 is
264 l_is_hankaku boolean := true;
265 l_chr varchar2(32767);
266 begin
267 if p_chr is not null then
268 if p_chr <> rpad(p_chr, length(p_chr)) then
269 l_is_hankaku := false;
270 end if;
271 /*
272 l_chr := translate(p_chr,
273 ' ' ||
274 c_hankaku.upper_alphabet ||
275 c_hankaku.lower_alphabet ||
276 c_hankaku.number ||
277 c_hankaku.symbol ||
278 c_hankaku.kana ||
279 c_hankaku.upper_kana ||
280 c_hankaku.lower_kana ||
281 c_hankaku.jp_symbol, ' ');
282 if replace(l_chr, ' ') is not null then
283 l_is_hankaku := false;
284 end if;
285 */
286 end if;
287 --
288 return l_is_hankaku;
289 end is_hankaku;
290 -- |---------------------------------------------------------------------------|
291 -- |------------------------------< is_zenkaku >-------------------------------|
292 -- |---------------------------------------------------------------------------|
293 function is_zenkaku(p_chr in varchar2) return boolean
294 is
295 l_is_zenkaku boolean := true;
296 l_chr varchar2(32767);
297 begin
298 if p_chr is not null then
299 if p_chr <> rpad(p_chr, length(p_chr) * 2) then
300 l_is_zenkaku := false;
301 end if;
302 end if;
303 --
304 return l_is_zenkaku;
305 end is_zenkaku;
306 -- |---------------------------------------------------------------------------|
307 -- |------------------------------< to_hankaku >-------------------------------|
308 -- |---------------------------------------------------------------------------|
309 function to_hankaku(
310 p_chr in varchar2,
311 p_replacement_chr in varchar2) return varchar2
312 is
313 l_str varchar2(32767);
314 l_old_str varchar2(8);
315 l_new_str varchar2(8);
316 l_old_chrs varchar2(32767);
317 l_new_chrs varchar2(32767);
318 l_length number;
319 l_index number;
320 begin
321 if p_chr is not null then
322 l_str := translate(p_chr,
323 c_zenkaku.upper_alphabet ||
324 c_zenkaku.lower_alphabet ||
325 c_zenkaku.number ||
326 c_zenkaku.symbol ||
327 c_zenkaku.kana ||
328 c_zenkaku.upper_kana ||
329 c_zenkaku.lower_kana ||
330 c_zenkaku.jp_symbol,
331 c_hankaku.upper_alphabet ||
332 c_hankaku.lower_alphabet ||
333 c_hankaku.number ||
334 c_hankaku.symbol ||
335 c_hankaku.kana ||
336 c_hankaku.upper_kana ||
337 c_hankaku.lower_kana ||
338 c_hankaku.jp_symbol);
339 --
340 -- Replace Voiced Letters
341 --
342 for i in 1..length(c_zenkaku.voiced_kana) loop
343 l_old_str := substr(c_zenkaku.voiced_kana, i, 1);
344 l_new_str := substr(c_hankaku.voiced_kana, i * 2 - 1, 2);
345 l_str := replace(l_str, l_old_str, l_new_str);
346 end loop;
347 --
348 if p_replacement_chr is null or p_replacement_chr <> hr_api.g_varchar2 then
349 if not is_hankaku(l_str) then
350 --
351 -- In most cases, length(l_src) will be very small number,
352 -- which will not cause performance issue.
353 --
354 l_old_chrs := translate2(l_str,
355 c_hankaku.upper_alphabet ||
356 c_hankaku.lower_alphabet ||
357 c_hankaku.number ||
358 c_hankaku.symbol ||
359 c_hankaku.kana ||
360 c_hankaku.upper_kana ||
361 c_hankaku.lower_kana ||
362 c_hankaku.jp_symbol);
363 --
364 l_length := length(l_old_chrs);
365 l_index := 1;
366 while l_index <= l_length loop
367 if is_hankaku(substr(l_old_chrs, l_index, 1)) then
368 l_old_str := substr(l_old_chrs, 1, l_index - 1) || substr(l_old_chrs, l_index + 1);
369 l_length := l_length - 1;
370 else
371 l_index := l_index + 1;
372 end if;
373 end loop;
374 --
375 if p_replacement_chr is not null then
376 if length(p_replacement_chr) > 1 or not is_hankaku(p_replacement_chr) then
377 fnd_message.set_name('PER', 'HR_JP_INVALID_REPLACEMENT_CHR');
378 fnd_message.set_token('REPLACEMENT_CHR', p_replacement_chr);
379 fnd_message.raise_error;
380 end if;
381 l_new_chrs := rpad(p_replacement_chr, l_length, p_replacement_chr);
382 l_str := translate(l_str, l_old_chrs, l_new_chrs);
383 else
384 l_str := translate2(l_str, l_old_chrs);
385 end if;
386 end if;
387 end if;
388 end if;
389 --
390 return l_str;
391 end to_hankaku;
392 --
393 function to_hankaku(
394 p_chr in varchar2) return varchar2
395 is
396 begin
397 return to_hankaku(p_chr, hr_api.g_varchar2);
398 end to_hankaku;
399 -- |---------------------------------------------------------------------------|
400 -- |------------------------------< to_zenkaku >-------------------------------|
401 -- |---------------------------------------------------------------------------|
402 function to_zenkaku(
403 p_chr in varchar2,
404 p_replacement_chr in varchar2) return varchar2
405 is
406 l_str varchar2(32767);
407 l_old_str varchar2(8);
408 l_new_str varchar2(8);
409 l_length number;
410 l_index number;
411 begin
412 if p_chr is not null then
413 l_str := p_chr;
414 --
415 -- Replace Voiced Letters "at first".
416 --
417 for i in 1..length(c_zenkaku.voiced_kana) loop
418 l_old_str := substr(c_hankaku.voiced_kana, i * 2 - 1, 2);
419 l_new_str := substr(c_zenkaku.voiced_kana, i, 1);
420 l_str := replace(l_str, l_old_str, l_new_str);
421 end loop;
422 --
423 l_str := translate(l_str,
424 c_hankaku.upper_alphabet ||
425 c_hankaku.lower_alphabet ||
426 c_hankaku.number ||
427 c_hankaku.symbol ||
428 c_hankaku.kana ||
429 c_hankaku.upper_kana ||
430 c_hankaku.lower_kana ||
431 c_hankaku.jp_symbol,
432 c_zenkaku.upper_alphabet ||
433 c_zenkaku.lower_alphabet ||
434 c_zenkaku.number ||
435 c_zenkaku.symbol ||
436 c_zenkaku.kana ||
437 c_zenkaku.upper_kana ||
438 c_zenkaku.lower_kana ||
439 c_zenkaku.jp_symbol);
440 --
441 if p_replacement_chr is null or p_replacement_chr <> hr_api.g_varchar2 then
442 if not is_zenkaku(l_str) then
443 --
444 -- It is very rare case to get into this if statement,
445 -- so we can ignore the performance.
446 --
447 if p_replacement_chr is not null then
448 if length(p_replacement_chr) > 1 or not is_zenkaku(p_replacement_chr) then
449 fnd_message.set_name('PER', 'HR_JP_INVALID_REPLACEMENT_CHR');
450 fnd_message.set_token('REPLACEMENT_CHR', p_replacement_chr);
451 fnd_message.raise_error;
452 end if;
453 end if;
454 --
455 l_length := length(l_str);
456 l_index := 1;
457 while l_index <= l_length loop
458 if not is_zenkaku(substr(l_str, l_index, 1)) then
459 l_str := substr(l_str, 1, l_index - 1) || p_replacement_chr || substr(l_str, l_index + 1);
460 --
461 if p_replacement_chr is null then
462 l_length := l_length - 1;
463 else
464 l_index := l_index + 1;
465 end if;
466 else
467 l_index := l_index + 1;
468 end if;
469 end loop;
470 end if;
471 end if;
472 end if;
473 --
474 return l_str;
475 end to_zenkaku;
476 --
477 function to_zenkaku(
478 p_chr in varchar2) return varchar2
479 is
480 begin
481 return to_zenkaku(p_chr, hr_api.g_varchar2);
482 end to_zenkaku;
483 -- |---------------------------------------------------------------------------|
484 -- |------------------------------< upper_kana >-------------------------------|
485 -- |---------------------------------------------------------------------------|
486 function upper_kana(p_chr in varchar2) return varchar2
487 is
488 begin
489 return translate(p_chr,
490 c_hankaku.lower_kana ||
491 c_zenkaku.lower_kana,
492 c_hankaku.upper_kana ||
493 c_zenkaku.upper_kana);
494 end upper_kana;
495 -- |---------------------------------------------------------------------------|
496 -- |------------------------------< lower_kana >-------------------------------|
497 -- |---------------------------------------------------------------------------|
498 function lower_kana(p_chr in varchar2) return varchar2
499 is
500 begin
501 return translate(p_chr,
502 c_hankaku.upper_kana ||
503 c_zenkaku.upper_kana,
504 c_hankaku.lower_kana ||
505 c_zenkaku.lower_kana);
506 end lower_kana;
507 -- |---------------------------------------------------------------------------|
508 -- |-----------------------------< upper_hankaku >-----------------------------|
509 -- |---------------------------------------------------------------------------|
510 function upper_hankaku(p_chr in varchar2) return varchar2
511 is
512 begin
513 --
514 -- UPPER function converts both Hankaku and Zenkaku apphabet characters.
515 -- This function converts only Hankaku characters, so us "translate"
516 -- instead of "upper".
517 --
518 return translate(p_chr,
519 c_hankaku.lower_kana || 'abcdefghijklmnopqrstuvwxyz',
520 c_hankaku.upper_kana || 'ABCDEFGHIJKLMNOPQRSTUVWXYZ');
521 end upper_hankaku;
522 -- |---------------------------------------------------------------------------|
523 -- |-------------------------------< to_table >--------------------------------|
524 -- |---------------------------------------------------------------------------|
525 procedure to_table(
526 p_str in varchar2,
527 p_lengthb in binary_integer,
528 p_str_tbl out nocopy t_varchar2_tbl)
529 is
530 l_posb number := 1;
531 l_pos number := 1;
532 l_str varchar2(4000);
533 l_str_dummy varchar2(32767);
534 l_length number;
535 l_index number := 0;
536 begin
537 if p_str is not null and p_lengthb > 0 then
538 while l_posb <= lengthb(p_str) loop
539 l_str := substrb(p_str, l_posb, p_lengthb);
540 l_length := length(l_str);
541 l_str_dummy := substr(p_str, l_pos, l_length);
542 --
543 if l_str <> l_str_dummy then
544 for i in reverse 0..(l_length - 1) loop
545 l_str := substr(l_str, 1, i);
546 l_str_dummy := substr(l_str_dummy, 1, i);
547 --
548 if l_str = l_str_dummy then
549 exit;
550 end if;
551 end loop;
552 end if;
553 --
554 if l_str is null then
555 exit;
556 end if;
557 --
558 l_index := l_index + 1;
559 p_str_tbl(l_index) := l_str;
560 l_posb := l_posb + lengthb(l_str);
561 l_pos := l_pos + length(l_str);
562 end loop;
563 end if;
564 end to_table;
565 --
566 function to_table(
567 p_str in varchar2,
568 p_lengthb in binary_integer) return FND_TABLE_OF_VARCHAR2_4000
569 is
570 l_temp_tbl t_varchar2_tbl;
571 l_count number;
572 l_str_tbl FND_TABLE_OF_VARCHAR2_4000;
573 begin
574 if p_str is not null then
575 to_table(p_str, p_lengthb, l_temp_tbl);
576 --
577 l_count := l_temp_tbl.count;
578 if l_count > 0 then
579 l_str_tbl := FND_TABLE_OF_VARCHAR2_4000();
580 l_str_tbl.extend(l_count);
581 --
582 for i in 1..l_count loop
583 l_str_tbl(i) := l_temp_tbl(i);
584 end loop;
585 end if;
586 end if;
587 --
588 return l_str_tbl;
589 end to_table;
590 --
591 function get_index_at(
592 p_varchar2_tbl in hr_jp_standard_pkg.t_varchar2_tbl,
593 p_index in number) return varchar2
594 is
595 begin
596 if p_varchar2_tbl.exists(p_index) then
597 return p_varchar2_tbl(p_index);
598 else
599 return null;
600 end if;
601 end get_index_at;
602 -- |---------------------------------------------------------------------------|
603 -- |------------------------------< to_jp_char >-------------------------------|
604 -- |---------------------------------------------------------------------------|
605 function to_jp_char(
606 p_date in date,
607 p_date_format in varchar2 default null) return varchar2
608 is
609 l_str varchar2(255);
610 begin
611 --
612 -- PL/SQL "to_char" has bug which does not work with "NLS" parameters.
613 -- We here use ORACLE "to_char" as a workaround.
614 --
615 if p_date is not null then
616 if p_date_format is not null then
617 select to_char(p_date, p_date_format, 'NLS_CALENDAR=''Japanese Imperial''')
618 into l_str
619 from dual;
620 else
621 select to_char(p_date, sys_context('USERENV', 'NLS_DATE_FORMAT'), 'NLS_CALENDAR=''Japanese Imperial''')
622 into l_str
623 from dual;
624 end if;
625 end if;
626 --
627 return l_str;
628 end to_jp_char;
629 -- |---------------------------------------------------------------------------|
630 -- |------------------------------< to_jp_date >-------------------------------|
631 -- |---------------------------------------------------------------------------|
632 function to_jp_date(
633 p_str in varchar2,
634 p_date_format in varchar2 default null) return date
635 is
636 l_date date;
637 begin
638 --
639 -- PL/SQL "to_char" has bug which does not work with "NLS" parameters.
640 -- We here use ORACLE "to_char" as a workaround.
641 --
642 if p_str is not null then
643 if p_date_format is not null then
644 select to_date(p_str, p_date_format, 'NLS_CALENDAR=''Japanese Imperial''')
645 into l_date
646 from dual;
647 else
648 select to_date(p_str, sys_context('USERENV', 'NLS_DATE_FORMAT'), 'NLS_CALENDAR=''Japanese Imperial''')
649 into l_date
650 from dual;
651 end if;
652 end if;
653 --
654 return l_date;
655 end to_jp_date;
656 -- |---------------------------------------------------------------------------|
657 -- |------------------------------< to_jis8_raw >------------------------------|
658 -- |---------------------------------------------------------------------------|
659 -- This function supports JIS-X0208 characters
660 -- JIS 524 Non-kanji characters
661 -- JIS 1st level 2965 Kanji characters
662 -- JIS 2nd level 3390 Kanji characters
663 function to_jis8_raw(
664 p_chr in varchar2,
665 p_ki in raw,
666 p_ko in raw) return raw
667 is
668 l_jisraw raw(32767);
669 l_sjhex varchar2(4);
670 l_high number;
671 l_low number;
672 --
673 -- <SJIS 1st byte>
674 -- 0x81(129) - 0x9F(159) (31 chars)
675 -- 0xE0(224) - 0xFC(252) (29 chars) --> 0xE0(224) - 0xEF(239) (16 chars)
676 -- 0xF0(240) - 0xFC(252) (13 chars)
677 --
678 -- <SJIS 2nd byte>
679 -- 0x40(64) - 0x7E(126) (63 chars)
680 -- 0x80(128) - 0xFC(252) (125 chars) --> 0x80(128) - 0x9E(158) (31 chars)
681 -- 0x9F(159) - 0xFC(252) (94 chars)
682 --
683 -- <JIS8 1st/2nd byte>
684 -- 0x21(33) - 0x7E(126) (94 chars) --> 0x21(33) - 0x5F(95) (63 chars)
685 -- 0x60(96) - 0x7E(126) (31 chars)
686 --
687 -- <Conversion Table from SJIS to JIS8>
688 -- <1st byte>
689 -- 0x81(129) - 0x9F(159) (31 chars) --> 0x21(33) - 0x5E(94) (62 chars)
690 -- 0xE0(224) - 0xEF(239) (16 chars) --> 0x5F(95) - 0x7E(126) (32 chars)
691 -- 0xF0(240) - 0xFC(252) (13 chars) --> 0x7F(127) - 0x98(152) (26 chars)*
692 --
693 -- <2nd byte>
694 -- 0x40(64) - 0x7E(126) --> 0x21(33) - 0x5F(95) (63 chars)
695 -- 0x80(128) - 0x9E(158) --> 0x60(96) - 0x7E(126) (31 chars)
696 -- 0x9F(159) - 0xFC(252) --> 0x21(33) - 0x7E(126) (94 chars)
697 --
698 l_ki boolean := false;
699 -- c_shift_in constant raw(3) := hextoraw('1B2442');
700 -- c_shift_out constant raw(3) := hextoraw('1B2842');
701 --
702 procedure ki
703 is
704 begin
705 if not l_ki then
706 l_jisraw := l_jisraw || p_ki;
707 l_ki := true;
708 end if;
709 end ki;
710 --
711 procedure ko
712 is
713 begin
714 if l_ki then
715 l_jisraw := l_jisraw || p_ko;
716 l_ki := false;
717 end if;
718 end ko;
719 begin
720 if p_chr is not null then
721 for i in 1..length(p_chr) loop
722 l_sjhex := chartosjhex(substr(p_chr, i, 1));
723 -- dbms_output.put_line(l_sjhex);
724 --
725 if l_sjhex is not null then
726 if length(l_sjhex) > 2 then
727 l_high := to_number(substr(l_sjhex, 1, 2), 'XX');
728 l_low := to_number(substr(l_sjhex, 3), 'XX');
729 --
730 if ((l_high between 129 and 159) or (l_high between 224 and 239))
731 -- if ((l_high between 129 and 159) or (l_high between 224 and 252))
732 and ((l_low between 64 and 126) or (l_low between 128 and 252)) then
733 if l_high <= 159 then
734 if l_low <= 158 then
735 l_high := l_high * 2 - 225;
736 else
737 l_high := l_high * 2 - 224;
738 end if;
739 else
740 if l_low <= 158 then
741 l_high := l_high * 2 - 353;
742 else
743 l_high := l_high * 2 - 352;
744 end if;
745 end if;
746 --
747 if l_low <= 126 then
748 l_low := l_low - 31;
749 elsif l_low <= 158 then
750 l_low := l_low - 32;
751 else
752 l_low := l_low - 126;
753 end if;
754 else
755 --
756 -- Unconvertable Kanji Characters.
757 -- Converted multibyte "?" (0x21 0x29)
758 --
759 l_high := 33;
760 l_low := 41;
761 end if;
762 --
763 ki;
764 --
765 l_jisraw := l_jisraw ||
766 hextoraw(lpad(to_char(l_high, 'FMXX'), 2, '0')) ||
767 hextoraw(lpad(to_char(l_low, 'FMXX'), 2, '0'));
768 else
769 ko;
770 --
771 l_jisraw := l_jisraw || hextoraw(l_sjhex);
772 end if;
773 end if;
774 end loop;
775 --
776 if l_jisraw is not null then
777 ko;
778 end if;
779 --
780 -- dbms_output.put_line(rawtohex(l_jisraw));
781 end if;
782 --
783 return l_jisraw;
784 end to_jis8_raw;
785 -- |---------------------------------------------------------------------------|
786 -- |--------------------------------< to_jis8 >--------------------------------|
787 -- |---------------------------------------------------------------------------|
788 function to_jis8(
789 p_chr in varchar2,
790 p_ki in raw,
791 p_ko in raw) return varchar2
792 is
793 begin
794 return utl_raw.cast_to_varchar2(to_jis8_raw(p_chr, p_ki, p_ko));
795 end to_jis8;
796 -- |---------------------------------------------------------------------------|
797 -- |----------------------------------< gcd >----------------------------------|
798 -- |---------------------------------------------------------------------------|
799 --
800 -- greatest common divisor
801 --
802 function gcd(a integer, b integer) return integer
803 is
804 l_a integer;
805 l_b integer;
806 begin
807 if a is not null and b is not null then
808 if a = 0 or b = 0 then
809 l_a := 0;
810 else
811 l_a := abs(a);
812 l_b := abs(b);
813 --
814 while (l_a <> l_b) loop
815 if l_a > l_b then
816 l_a := l_a - l_b;
817 else
818 l_b := l_b - l_a;
819 end if;
820 end loop;
821 end if;
822 end if;
823 --
824 return l_a;
825 end gcd;
826 -- |---------------------------------------------------------------------------|
827 -- |----------------------------------< lcm >----------------------------------|
828 -- |---------------------------------------------------------------------------|
829 --
830 -- least common multiple
831 --
832 function lcm(a integer, b integer) return integer
833 is
834 l_lcm integer;
835 begin
836 if a is not null and b is not null then
837 if a = 0 or b = 0 then
838 l_lcm := 0;
839 else
840 l_lcm := a * b / gcd(a, b);
841 end if;
842 end if;
843 --
844 return l_lcm;
845 end lcm;
846 -- |---------------------------------------------------------------------------|
847 -- |------------------------------< get_message >------------------------------|
848 -- |---------------------------------------------------------------------------|
849 /*
850 function get_message(
851 p_application_short_name in varchar2,
852 p_message_name in varchar2,
853 p_token_name1 in varchar2 default null,
854 p_token_value1 in varchar2 default null,
855 p_token_name2 in varchar2 default null,
856 p_token_value2 in varchar2 default null,
857 p_token_name3 in varchar2 default null,
858 p_token_value3 in varchar2 default null,
859 p_token_name4 in varchar2 default null,
860 p_token_value4 in varchar2 default null,
861 p_token_name5 in varchar2 default null,
862 p_token_value5 in varchar2 default null) return varchar2
863 is
864 procedure set_token(
865 p_token_name in varchar2,
866 p_token_value in varchar2)
867 is
868 begin
869 if p_token_name is not null then
870 fnd_message.set_token(p_token_name, p_token_value);
871 end if;
872 end set_token;
873 begin
874 fnd_message.set_name(p_application_short_name, p_message_name);
875 set_token(p_token_name1, p_token_value1);
876 set_token(p_token_name2, p_token_value2);
877 set_token(p_token_name3, p_token_value3);
878 set_token(p_token_name4, p_token_value4);
879 set_token(p_token_name5, p_token_value5);
880 --
881 return fnd_message.get;
882 end get_message;
883 */
884 --
885 function get_message(
886 p_application_short_name in varchar2,
887 p_message_name in varchar2,
888 p_language_code in varchar2,
889 p_token_name1 in varchar2 default null,
890 p_token_value1 in varchar2 default null,
891 p_token_name2 in varchar2 default null,
892 p_token_value2 in varchar2 default null,
893 p_token_name3 in varchar2 default null,
894 p_token_value3 in varchar2 default null,
895 p_token_name4 in varchar2 default null,
896 p_token_value4 in varchar2 default null,
897 p_token_name5 in varchar2 default null,
898 p_token_value5 in varchar2 default null) return varchar2
899 is
900 l_language_code fnd_new_messages.language_code%type;
901 l_message_text fnd_new_messages.message_text%type;
902 l_not_found boolean := false;
903 --
904 cursor csr_message_text(cp_language_code in varchar2) is
905 select message_text
906 from fnd_application a,
907 fnd_new_messages m
908 where a.application_short_name = p_application_short_name
909 and m.application_id = a.application_id
910 and m.message_name = p_message_name
911 and m.language_code = cp_language_code;
912 --
913 procedure replace_token(
914 p_message_text in out nocopy varchar2,
915 p_token_name in varchar2,
916 p_token_value in varchar2)
917 is
918 l_token_name varchar2(2000);
919 begin
920 if p_message_text is not null and p_token_name is not null then
921 l_token_name := '&' || p_token_name;
922 --
923 if instr(p_message_text, l_token_name) > 0 then
924 p_message_text := replace(p_message_text, l_token_name, p_token_value);
925 end if;
926 end if;
927 end replace_token;
928 begin
929 if p_language_code is not null then
930 l_language_code := p_language_code;
931 else
932 l_language_code := userenv('LANG');
933 end if;
934 --
935 open csr_message_text(l_language_code);
936 fetch csr_message_text into l_message_text;
937 if csr_message_text%notfound then
938 l_not_found := true;
939 end if;
940 close csr_message_text;
941 --
942 if l_not_found then
943 open csr_message_text('US');
944 fetch csr_message_text into l_message_text;
945 close csr_message_text;
946 end if;
947 --
948 if l_message_text is not null then
949 replace_token(l_message_text, p_token_name1, p_token_value1);
950 replace_token(l_message_text, p_token_name2, p_token_value2);
951 replace_token(l_message_text, p_token_name3, p_token_value3);
952 replace_token(l_message_text, p_token_name4, p_token_value4);
953 replace_token(l_message_text, p_token_name5, p_token_value5);
954 end if;
955 --
956 return l_message_text;
957 end get_message;
958 --
959 END hr_jp_standard_pkg;