romfast/gomag-vending
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
61193b793f17206d5081fe5e685b2379b66e24f6
gomag-vending/api/database-scripts/co_2026_03_16_01_COMUN_PLJSON.sql
Claude Agent 70267d9d8d corectie pljson
2026-03-24 11:48:13 +00:00

5081 lines
180 KiB
MySQL
Raw Blame History

-- ====================================================================
-- co_2026_03_16_01_COMUN_PLJSON.sql
-- Instaleaza PL/JSON (minimal core) in schema CONTAFIN_ORACLE
-- cu GRANT EXECUTE si PUBLIC SYNONYM pentru acces din alte scheme
--
-- Rulare: sqlplus CONTAFIN_ORACLE/password@ROA_ROMFAST @co_2026_03_10_02_COMUN_PLJSON.sql
--
-- Sursa: https://github.com/pljson/pljson (MIT License)
-- Versiune: 3.7.1 (core minimal - fara addons)
-- Script self-contained - nu necesita fisiere externe
-- ====================================================================
SET SERVEROUTPUT ON SIZE UNLIMITED
SET DEFINE OFF
ALTER SESSION SET PLSQL_OPTIMIZE_LEVEL = 2;
PROMPT;
PROMPT =============================================;
PROMPT PL/JSON - Instalare in CONTAFIN_ORACLE;
PROMPT =============================================;
PROMPT;
-- ====================================================================
-- STEP 1: Cleanup - sterge obiectele existente (safe)
-- ====================================================================
PROMPT [1/6] Cleanup obiecte existente...;
BEGIN
-- Packages
BEGIN EXECUTE IMMEDIATE 'DROP PACKAGE pljson_parser'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP PACKAGE pljson_printer'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP PACKAGE pljson_ext'; EXCEPTION WHEN OTHERS THEN NULL; END;
-- Public synonyms
BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_list'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_element'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_element_array'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_string'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_number'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_bool'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_null'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_varray'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_narray'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_parser'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_printer'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_ext'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_path_segment'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_path'; EXCEPTION WHEN OTHERS THEN NULL; END;
-- Types (ordinea conteaza - dependentele ultimele)
BEGIN EXECUTE IMMEDIATE 'DROP TYPE pljson FORCE'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP TYPE pljson_list FORCE'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP TYPE pljson_string FORCE'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP TYPE pljson_number FORCE'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP TYPE pljson_bool FORCE'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP TYPE pljson_null FORCE'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP TYPE pljson_element_array FORCE'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP TYPE pljson_element FORCE'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP TYPE pljson_path_segment FORCE'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP TYPE pljson_path FORCE'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP TYPE pljson_narray FORCE'; EXCEPTION WHEN OTHERS THEN NULL; END;
BEGIN EXECUTE IMMEDIATE 'DROP TYPE pljson_varray FORCE'; EXCEPTION WHEN OTHERS THEN NULL; END;
END;
/
-- ====================================================================
-- STEP 2: Creare tipuri si declaratii (in ordinea dependentelor)
-- ====================================================================
PROMPT [2/6] Creare tipuri de baza...;
-- --- pljson_element.type.decl ---
create or replace type pljson_path_segment as object (
indx number(32),
name varchar2(4000)
) final
/
create or replace type pljson_path as table of pljson_path_segment
/
create or replace type pljson_element force as object
(
/* 1 = object, 2 = array, 3 = string, 4 = number, 5 = bool, 6 = null */
typeval number(1),
mapname varchar2(4000),
mapindx number(32),
object_id number,
/* not instantiable */
constructor function pljson_element return self as result,
member function is_object return boolean,
member function is_array return boolean,
member function is_string return boolean,
member function is_number return boolean,
member function is_bool return boolean,
member function is_null return boolean,
member function get_type return varchar2,
/* should be overriden */
member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2,
/*
member methods to remove need for treat()
*/
member function get_string(max_byte_size number default null, max_char_size number default null) return varchar2,
member function get_clob return clob,
member function get_number return number,
/* E.I.Sarmas (github.com/dsnz) 2016-11-03 support for binary_double numbers */
member function get_double return binary_double,
/* E.I.Sarmas (github.com/dsnz) 2016-11-03 support for binary_double numbers, is_number is still true, extra info */
/* return true if 'number' is representable by Oracle number */
/** Private method for internal processing. */
member function is_number_repr_number return boolean,
/* return true if 'number' is representable by Oracle binary_double */
/** Private method for internal processing. */
member function is_number_repr_double return boolean,
member function get_bool return boolean,
member function count return number,
member function get(pair_name varchar2) return pljson_element,
member function get(position pls_integer) return pljson_element,
member function path(json_path varchar2, base number default 1) return pljson_element,
/* output methods */
member function to_char(spaces boolean default true, chars_per_line number default 0) return varchar2,
member procedure to_clob(self in pljson_element, buf in out nocopy clob, spaces boolean default false, chars_per_line number default 0, erase_clob boolean default true),
member procedure print(self in pljson_element, spaces boolean default true, chars_per_line number default 8192, jsonp varchar2 default null),
member procedure htp(self in pljson_element, spaces boolean default false, chars_per_line number default 0, jsonp varchar2 default null),
/* private method for internal use, not part of the API, contributed by @asfernandes */
member procedure get_internal_path(self in pljson_element, path pljson_path, path_position pls_integer, ret out nocopy pljson_element),
/* private method for internal use, not part of the API, contributed by @asfernandes */
member function put_internal_path(self in out nocopy pljson_element, path pljson_path, elem pljson_element, path_position pls_integer) return boolean
) not final
/
show err
create or replace type pljson_element_array as table of pljson_element
/
-- --- pljson_list.type.decl ---
set termout off
create or replace type pljson_varray as table of varchar2(32767);
/
create or replace type pljson_narray as table of number;
/
set termout on
create or replace type pljson_list force under pljson_element (
/*
Copyright (c) 2010 Jonas Krogsboell
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
*/
/* variables */
list_data pljson_element_array,
/* constructors */
constructor function pljson_list return self as result,
constructor function pljson_list(str varchar2) return self as result,
constructor function pljson_list(str clob) return self as result,
constructor function pljson_list(str blob, charset varchar2 default 'UTF8') return self as result,
constructor function pljson_list(str_array pljson_varray) return self as result,
constructor function pljson_list(num_array pljson_narray) return self as result,
constructor function pljson_list(elem pljson_element) return self as result,
constructor function pljson_list(elem_array pljson_element_array) return self as result,
overriding member function is_array return boolean,
overriding member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2,
/* list management */
member procedure append(self in out nocopy pljson_list, elem pljson_element, position pls_integer default null),
member procedure append(self in out nocopy pljson_list, elem varchar2, position pls_integer default null),
member procedure append(self in out nocopy pljson_list, elem clob, position pls_integer default null),
member procedure append(self in out nocopy pljson_list, elem number, position pls_integer default null),
/* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */
member procedure append(self in out nocopy pljson_list, elem binary_double, position pls_integer default null),
member procedure append(self in out nocopy pljson_list, elem boolean, position pls_integer default null),
member procedure append(self in out nocopy pljson_list, elem pljson_list, position pls_integer default null),
member procedure replace(self in out nocopy pljson_list, position pls_integer, elem pljson_element),
member procedure replace(self in out nocopy pljson_list, position pls_integer, elem varchar2),
member procedure replace(self in out nocopy pljson_list, position pls_integer, elem clob),
member procedure replace(self in out nocopy pljson_list, position pls_integer, elem number),
/* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */
member procedure replace(self in out nocopy pljson_list, position pls_integer, elem binary_double),
member procedure replace(self in out nocopy pljson_list, position pls_integer, elem boolean),
member procedure replace(self in out nocopy pljson_list, position pls_integer, elem pljson_list),
member procedure remove(self in out nocopy pljson_list, position pls_integer),
member procedure remove_first(self in out nocopy pljson_list),
member procedure remove_last(self in out nocopy pljson_list),
overriding member function count return number,
overriding member function get(position pls_integer) return pljson_element,
member function get_string(position pls_integer) return varchar2,
member function get_clob(position pls_integer) return clob,
member function get_number(position pls_integer) return number,
member function get_double(position pls_integer) return binary_double,
member function get_bool(position pls_integer) return boolean,
member function get_pljson_list(position pls_integer) return pljson_list,
member function head return pljson_element,
member function last return pljson_element,
member function tail return pljson_list,
/* json path */
overriding member function path(json_path varchar2, base number default 1) return pljson_element,
/* json path_put */
member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem pljson_element, base number default 1),
member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem varchar2, base number default 1),
member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem clob, base number default 1),
member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem number, base number default 1),
/* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */
member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem binary_double, base number default 1),
member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem boolean, base number default 1),
member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem pljson_list, base number default 1),
/* json path_remove */
member procedure path_remove(self in out nocopy pljson_list, json_path varchar2, base number default 1),
/* private method for internal use, not part of the API, contributed by @asfernandes */
overriding member procedure get_internal_path(self in pljson_list, path pljson_path, path_position pls_integer, ret out nocopy pljson_element),
/* private method for internal use, not part of the API, contributed by @asfernandes */
overriding member function put_internal_path(self in out nocopy pljson_list, path pljson_path, elem pljson_element, path_position pls_integer) return boolean
) not final;
/
show err
set termout on
create or replace type pljson force under pljson_element (
/*
Copyright (c) 2010 Jonas Krogsboell
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
*/
/* variables */
json_data pljson_element_array,
check_for_duplicate number,
/* constructors */
constructor function pljson return self as result,
constructor function pljson(str varchar2) return self as result,
constructor function pljson(str in clob) return self as result,
constructor function pljson(str in blob, charset varchar2 default 'UTF8') return self as result,
constructor function pljson(str_array pljson_varray) return self as result,
constructor function pljson(elem pljson_element) return self as result,
constructor function pljson(l pljson_list) return self as result,
overriding member function is_object return boolean,
overriding member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2,
/* member management */
member procedure remove(pair_name varchar2),
member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value pljson_element, position pls_integer default null),
member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value varchar2, position pls_integer default null),
member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value clob, position pls_integer default null),
member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value number, position pls_integer default null),
/* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */
member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value binary_double, position pls_integer default null),
member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value boolean, position pls_integer default null),
member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value pljson, position pls_integer default null),
member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value pljson_list, position pls_integer default null),
overriding member function count return number,
overriding member function get(pair_name varchar2) return pljson_element,
member function get_string(pair_name varchar2) return varchar2,
member function get_clob(pair_name varchar2) return clob,
member function get_number(pair_name varchar2) return number,
member function get_double(pair_name varchar2) return binary_double,
member function get_bool(pair_name varchar2) return boolean,
member function get_pljson(pair_name varchar2) return pljson,
member function get_pljson_list(pair_name varchar2) return pljson_list,
overriding member function get(position pls_integer) return pljson_element,
member function index_of(pair_name varchar2) return number,
member function exist(pair_name varchar2) return boolean,
member procedure check_duplicate(self in out nocopy pljson, v_set boolean),
member procedure remove_duplicates(self in out nocopy pljson),
/* json path */
overriding member function path(json_path varchar2, base number default 1) return pljson_element,
/* json path_put */
member procedure path_put(self in out nocopy pljson, json_path varchar2, elem pljson_element, base number default 1),
member procedure path_put(self in out nocopy pljson, json_path varchar2, elem varchar2, base number default 1),
member procedure path_put(self in out nocopy pljson, json_path varchar2, elem clob, base number default 1),
member procedure path_put(self in out nocopy pljson, json_path varchar2, elem number, base number default 1),
/* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */
member procedure path_put(self in out nocopy pljson, json_path varchar2, elem binary_double, base number default 1),
member procedure path_put(self in out nocopy pljson, json_path varchar2, elem boolean, base number default 1),
member procedure path_put(self in out nocopy pljson, json_path varchar2, elem pljson, base number default 1),
member procedure path_put(self in out nocopy pljson, json_path varchar2, elem pljson_list, base number default 1),
/* json path_remove */
member procedure path_remove(self in out nocopy pljson, json_path varchar2, base number default 1),
/* map functions */
member function get_keys return pljson_list,
member function get_values return pljson_list,
/* private method for internal use, not part of the API, contributed by @asfernandes */
overriding member procedure get_internal_path(self in pljson, path pljson_path, path_position pls_integer, ret out nocopy pljson_element),
/* private method for internal use, not part of the API, contributed by @asfernandes */
overriding member function put_internal_path(self in out nocopy pljson, path pljson_path, elem pljson_element, path_position pls_integer) return boolean
) not final;
/
show err
-- --- pljson_string.type (spec + body) ---
create or replace type pljson_string force under pljson_element (
num number,
str varchar2(32767),
extended_str clob,
unescaped_string_delim_p number, -- 0/1 for false/true
unescaped_string_delim varchar2(10),
constructor function pljson_string(str varchar2, esc boolean default true,
unescaped_string_delim_p boolean default false, unescaped_string_delim varchar2 default '') return self as result,
constructor function pljson_string(str clob, esc boolean default true,
unescaped_string_delim_p boolean default false, unescaped_string_delim varchar2 default '') return self as result,
overriding member function is_string return boolean,
overriding member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2,
overriding member function get_string(max_byte_size number default null, max_char_size number default null) return varchar2,
overriding member function get_clob return clob
/*
member procedure get_string(buf in out nocopy clob)
*/
) not final
/
show err
create or replace type body pljson_string as
constructor function pljson_string(str varchar2, esc boolean default true,
unescaped_string_delim_p boolean default false, unescaped_string_delim varchar2 default '') return self as result as
begin
self.typeval := 3;
if (esc) then self.num := 1; else self.num := 0; end if; --message to pretty printer
self.str := str;
-- unescaped string delimiter
self.unescaped_string_delim_p := 0;
if unescaped_string_delim_p then
self.unescaped_string_delim_p := 1;
self.unescaped_string_delim := unescaped_string_delim;
end if;
return;
end;
constructor function pljson_string(str clob, esc boolean default true,
unescaped_string_delim_p boolean default false, unescaped_string_delim varchar2 default '') return self as result as
/* E.I.Sarmas (github.com/dsnz) 2016-01-21 limit to 5000 chars */
/* for Unicode text, varchar2 'self.str' not exceed 5000 chars, does not limit size of data */
max_string_chars number := 5000; /* chunk size, less than this number may be copied */
lengthcc number;
begin
self.typeval := 3;
if (esc) then self.num := 1; else self.num := 0; end if; --message to pretty printer
-- lengthcc := pljson_parser.lengthcc(str);
-- if lengthcc > max_string_chars then
/* not so accurate, may be less than "max_string_chars" */
/* it's not absolute restricting limit and it's faster than using lengthcc */
if (dbms_lob.getlength(str) > max_string_chars) then
self.extended_str := str;
end if;
-- GHS 20120615: Added IF structure to handle null clobs
if dbms_lob.getlength(str) > 0 then
/* may read less than "max_string_chars" characters but it's a sample so doesn't matter */
dbms_lob.read(str, max_string_chars, 1, self.str);
end if;
-- unescaped string delimiter
self.unescaped_string_delim_p := 0;
if unescaped_string_delim_p then
self.unescaped_string_delim_p := 1;
self.unescaped_string_delim := unescaped_string_delim;
end if;
return;
end;
overriding member function is_string return boolean as
begin
return true;
end;
overriding member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2 as
begin
return get_string(max_byte_size, max_char_size);
end;
overriding member function get_string(max_byte_size number default null, max_char_size number default null) return varchar2 as
begin
if (max_byte_size is not null) then
return substrb(self.str, 1, max_byte_size);
elsif (max_char_size is not null) then
return substr(self.str, 1, max_char_size);
else
return self.str;
end if;
end;
overriding member function get_clob return clob as
begin
if (extended_str is not null) then
--dbms_lob.copy(buf, extended_str, dbms_lob.getlength(extended_str));
return self.extended_str;
else
/* writeappend works with length2() value */
--dbms_lob.writeappend(buf, length2(self.str), self.str);
return self.str;
end if;
end;
/*
member procedure get_string(buf in out nocopy clob) as
begin
dbms_lob.trim(buf, 0);
if (extended_str is not null) then
dbms_lob.copy(buf, extended_str, dbms_lob.getlength(extended_str));
else
-- writeappend works with length2() value
dbms_lob.writeappend(buf, length2(self.str), self.str);
end if;
end;
*/
end;
/
show err
-- --- pljson_number.type (spec + body) ---
create or replace type pljson_number force under pljson_element
(
num number,
num_double binary_double, -- both num and num_double are set, there is never exception (until Oracle 12c)
num_repr_number_p varchar2(1),
num_repr_double_p varchar2(1),
constructor function pljson_number(num number) return self as result,
/* E.I.Sarmas (github.com/dsnz) 2016-11-03 support for binary_double numbers */
constructor function pljson_number(num_double binary_double) return self as result,
overriding member function is_number return boolean,
overriding member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2,
overriding member function get_number return number,
/* E.I.Sarmas (github.com/dsnz) 2016-11-03 support for binary_double numbers */
overriding member function get_double return binary_double,
/* E.I.Sarmas (github.com/dsnz) 2016-11-03 support for binary_double numbers, is_number is still true, extra info */
/* return true if 'number' is representable by Oracle number */
/** Private method for internal processing. */
overriding member function is_number_repr_number return boolean,
/* return true if 'number' is representable by Oracle binary_double */
/** Private method for internal processing. */
overriding member function is_number_repr_double return boolean,
/* E.I.Sarmas (github.com/dsnz) 2016-11-03 support for binary_double numbers */
-- set value for number from string representation; to replace to_number in pljson_parser
-- can automatically decide and use binary_double if needed
-- less confusing than new constructor with dummy argument for overloading
-- centralized parse_number to use everywhere else and replace code in pljson_parser
-- this procedure is meant to be used internally only
-- procedure does not work correctly if called standalone in locales that
-- use a character other than "." for decimal point
member procedure parse_number(str varchar2),
/* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */
-- this procedure is meant to be used internally only
member function number_toString return varchar2
) not final
/
show err
create or replace type body pljson_number as
constructor function pljson_number(num number) return self as result as
begin
self.typeval := 4;
self.num := nvl(num, 0);
/* E.I.Sarmas (github.com/dsnz) 2016-11-03 support for binary_double numbers; typeval not changed, it is still json number */
self.num_repr_number_p := 't';
self.num_double := num;
if (to_number(self.num_double) = self.num) then
self.num_repr_double_p := 't';
else
self.num_repr_double_p := 'f';
end if;
return;
end;
/* E.I.Sarmas (github.com/dsnz) 2016-11-03 support for binary_double numbers; typeval not changed, it is still json number */
constructor function pljson_number(num_double binary_double) return self as result as
begin
self.typeval := 4;
self.num_double := nvl(num_double, 0);
self.num_repr_double_p := 't';
self.num := num_double;
if (to_binary_double(self.num) = self.num_double) then
self.num_repr_number_p := 't';
else
self.num_repr_number_p := 'f';
end if;
return;
end;
overriding member function is_number return boolean as
begin
return true;
end;
overriding member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2 as
begin
return self.num;
end;
overriding member function get_number return number as
begin
return self.num;
end;
/* E.I.Sarmas (github.com/dsnz) 2016-11-03 support for binary_double numbers */
overriding member function get_double return binary_double as
begin
return self.num_double;
end;
/* E.I.Sarmas (github.com/dsnz) 2016-11-03 support for binary_double numbers, is_number is still true, extra check */
/* return true if 'number' is representable by Oracle number */
overriding member function is_number_repr_number return boolean is
begin
return (num_repr_number_p = 't');
end;
/* return true if 'number' is representable by Oracle binary_double */
overriding member function is_number_repr_double return boolean is
begin
return (num_repr_double_p = 't');
end;
/* E.I.Sarmas (github.com/dsnz) 2016-11-03 support for binary_double numbers */
-- set value for number from string representation; to replace to_number in pljson_parser
-- can automatically decide and use binary_double if needed (set repr variables)
-- underflows and overflows count as representable if happen on both type representations
-- less confusing than new constructor with dummy argument for overloading
-- centralized parse_number to use everywhere else and replace code in pljson_parser
--
-- WARNING:
--
-- procedure does not work correctly if called standalone in locales that
-- use a character other than "." for decimal point
--
-- parse_number() is intended to be used inside pljson_parser which
-- uses session NLS_PARAMETERS to get decimal point and
-- changes "." to this decimal point before calling parse_number()
--
member procedure parse_number(str varchar2) is
begin
self.num := to_number(str);
self.num_repr_number_p := 't';
self.num_double := to_binary_double(str);
self.num_repr_double_p := 't';
if (to_binary_double(self.num) != self.num_double) then
self.num_repr_number_p := 'f';
end if;
if (to_number(self.num_double) != self.num) then
self.num_repr_double_p := 'f';
end if;
end parse_number;
/* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */
-- centralized toString to use everywhere else and replace code in pljson_printer
member function number_toString return varchar2 is
num number;
num_double binary_double;
buf varchar2(4000);
begin
/* unrolled, instead of using two nested fuctions for speed */
if (self.num_repr_number_p = 't') then
num := self.num;
if (num > 1e127d) then
return '1e309'; -- json representation of infinity !?
end if;
if (num < -1e127d) then
return '-1e309'; -- json representation of infinity !?
end if;
buf := STANDARD.to_char(num, 'TM9', 'NLS_NUMERIC_CHARACTERS=''.,''');
if (-1 < num and num < 0 and substr(buf, 1, 2) = '-.') then
buf := '-0' || substr(buf, 2);
elsif (0 < num and num < 1 and substr(buf, 1, 1) = '.') then
buf := '0' || buf;
end if;
return buf;
else
num_double := self.num_double;
if (num_double = +BINARY_DOUBLE_INFINITY) then
return '1e309'; -- json representation of infinity !?
end if;
if (num_double = -BINARY_DOUBLE_INFINITY) then
return '-1e309'; -- json representation of infinity !?
end if;
buf := STANDARD.to_char(num_double, 'TM9', 'NLS_NUMERIC_CHARACTERS=''.,''');
if (-1 < num_double and num_double < 0 and substr(buf, 1, 2) = '-.') then
buf := '-0' || substr(buf, 2);
elsif (0 < num_double and num_double < 1 and substr(buf, 1, 1) = '.') then
buf := '0' || buf;
end if;
return buf;
end if;
end number_toString;
end;
/
show err
-- --- pljson_bool.type (spec + body) ---
create or replace type pljson_bool force under pljson_element (
num number(1),
constructor function pljson_bool (b in boolean) return self as result,
overriding member function is_bool return boolean,
overriding member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2,
overriding member function get_bool return boolean
) not final
/
show err
create or replace type body pljson_bool as
constructor function pljson_bool (b in boolean) return self as result as
begin
self.typeval := 5;
self.num := 0;
if b then self.num := 1; end if;
return;
end;
overriding member function is_bool return boolean as
begin
return true;
end;
overriding member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2 as
begin
if self.num = 1 then return 'true'; else return 'false'; end if;
end;
overriding member function get_bool return boolean as
begin
return self.num = 1;
end;
end;
/
show err
-- --- pljson_null.type (spec + body) ---
create or replace type pljson_null force under pljson_element
(
constructor function pljson_null return self as result,
overriding member function is_null return boolean,
overriding member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2
) not final
/
show err
create or replace type body pljson_null as
constructor function pljson_null return self as result as
begin
self.typeval := 6;
return;
end;
overriding member function is_null return boolean as
begin
return true;
end;
overriding member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2 as
begin
return 'null';
end;
end;
/
show err
-- ====================================================================
-- STEP 3: Creare package specs
-- ====================================================================
PROMPT [3/6] Creare package specifications...;
-- --- pljson_ext.decl ---
create or replace package pljson_ext as
/*
Copyright (c) 2009 Jonas Krogsboell
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
*/
/* This package contains extra methods to lookup types and
an easy way of adding date values in json - without changing the structure */
function parsePath(json_path varchar2, base number default 1) return pljson_list;
--JSON pre-parsed path getters
function get_json_element(obj pljson, path pljson_list) return pljson_element;
function get_string(obj pljson, path pljson_list) return varchar2;
function get_number(obj pljson, path pljson_list) return number;
function get_double(obj pljson, path pljson_list) return binary_double;
function get_json(obj pljson, path pljson_list) return pljson;
function get_json_list(obj pljson, path pljson_list) return pljson_list;
function get_bool(obj pljson, path pljson_list) return boolean;
function get_date(obj pljson, path pljson_list) return date;
--saved original code, in case of future bug troubleshooting
function get_json_element_original(obj pljson, v_path varchar2, base number default 1) return pljson_element;
--JSON Path getters
function get_json_element(obj pljson, v_path varchar2, base number default 1) return pljson_element;
function get_string(obj pljson, path varchar2, base number default 1) return varchar2;
function get_number(obj pljson, path varchar2, base number default 1) return number;
function get_double(obj pljson, path varchar2, base number default 1) return binary_double;
function get_json(obj pljson, path varchar2, base number default 1) return pljson;
function get_json_list(obj pljson, path varchar2, base number default 1) return pljson_list;
function get_bool(obj pljson, path varchar2, base number default 1) return boolean;
--JSON pre-parsed path putters
procedure put(obj in out nocopy pljson, path pljson_list, elem varchar2);
procedure put(obj in out nocopy pljson, path pljson_list, elem number);
procedure put(obj in out nocopy pljson, path pljson_list, elem binary_double);
procedure put(obj in out nocopy pljson, path pljson_list, elem pljson);
procedure put(obj in out nocopy pljson, path pljson_list, elem pljson_list);
procedure put(obj in out nocopy pljson, path pljson_list, elem boolean);
procedure put(obj in out nocopy pljson, path pljson_list, elem pljson_element);
procedure put(obj in out nocopy pljson, path pljson_list, elem date);
--JSON Path putters
procedure put(obj in out nocopy pljson, path varchar2, elem varchar2, base number default 1);
procedure put(obj in out nocopy pljson, path varchar2, elem number, base number default 1);
procedure put(obj in out nocopy pljson, path varchar2, elem binary_double, base number default 1);
procedure put(obj in out nocopy pljson, path varchar2, elem pljson, base number default 1);
procedure put(obj in out nocopy pljson, path varchar2, elem pljson_list, base number default 1);
procedure put(obj in out nocopy pljson, path varchar2, elem boolean, base number default 1);
procedure put(obj in out nocopy pljson, path varchar2, elem pljson_element, base number default 1);
procedure remove(obj in out nocopy pljson, path pljson_list);
procedure remove(obj in out nocopy pljson, path varchar2, base number default 1);
--Pretty print with JSON Path - obsolete in 0.9.4 - obj.path(v_path).(to_char,print,htp)
function pp(obj pljson, v_path varchar2) return varchar2;
procedure pp(obj pljson, v_path varchar2); --using dbms_output.put_line
procedure pp_htp(obj pljson, v_path varchar2); --using htp.print
--extra function checks if number has no fraction
function is_integer(v pljson_element) return boolean;
format_string varchar2(30 char) := 'yyyy-mm-dd hh24:mi:ss';
--extension enables json to store dates without compromising the implementation
function to_json_string(d date) return pljson_string;
--notice that a date type in json is also a varchar2
function is_date(v pljson_element) return boolean;
--conversion is needed to extract dates
function to_date(v pljson_element) return date;
-- alias so that old code doesn't break
function to_date2(v pljson_element) return date;
--JSON Path with date
function get_date(obj pljson, path varchar2, base number default 1) return date;
procedure put(obj in out nocopy pljson, path varchar2, elem date, base number default 1);
/*
encoding in lines of 64 chars ending with CR+NL
*/
function encodeBase64Blob2Clob(p_blob in blob) return clob;
/*
assumes single base64 string or broken into equal length lines of max 64 or 76 chars
(as specified by RFC-1421 or RFC-2045)
line ending can be CR+NL or NL
*/
function decodeBase64Clob2Blob(p_clob clob) return blob;
function base64(binarydata blob) return pljson_list;
function base64(l pljson_list) return blob;
function encode(binarydata blob) return pljson_string;
function decode(v pljson_string) return blob;
/*
implemented as a procedure to force you to declare the CLOB so you can free it later
*/
procedure blob2clob(b blob, c out clob, charset varchar2 default 'UTF8');
end pljson_ext;
/
show err
-- --- pljson_parser.decl ---
create or replace package pljson_parser as
/*
Copyright (c) 2010 Jonas Krogsboell
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
*/
/** Internal type for processing. */
/* scanner tokens:
'{', '}', ',', ':', '[', ']', STRING, NUMBER, TRUE, FALSE, NULL
*/
type rToken IS RECORD (
type_name VARCHAR2(7),
line PLS_INTEGER,
col PLS_INTEGER,
data VARCHAR2(32767),
data_overflow clob); -- max_string_size
type lTokens is table of rToken index by pls_integer;
type json_src is record (len number, offset number, offset_chars number, src varchar2(32767), s_clob clob, src_len number, src_array pljson_varray);
json_strict boolean not null := false;
empty_string_as_null boolean not null := false;
ucs2_exception EXCEPTION;
pragma exception_init(ucs2_exception, -22831);
procedure set_buffer_amount(amount pls_integer);
function lengthcc(buf clob) return number;
function next_char(indx number, s in out nocopy json_src) return varchar2;
function next_char2(indx number, s in out nocopy json_src, amount number default 1) return varchar2;
function parseObj(tokens lTokens, indx in out nocopy pls_integer) return pljson;
function prepareClob(buf in clob) return pljson_parser.json_src;
function prepareVarchar2(buf in varchar2) return pljson_parser.json_src;
function lexer(jsrc in out nocopy json_src) return lTokens;
procedure print_token(t rToken);
/**
* <p>Primary parsing method. It can parse a JSON object.</p>
*
* @return An instance of <code>pljson</code>.
* @throws PARSER_ERROR -20101 when invalid input found.
* @throws SCANNER_ERROR -20100 when lexing fails.
*/
function parser(str varchar2) return pljson;
function parse_list(str varchar2) return pljson_list;
function parse_any(str varchar2) return pljson_element;
function parser(str clob) return pljson;
function parse_list(str clob) return pljson_list;
function parse_any(str clob) return pljson_element;
procedure remove_duplicates(obj in out nocopy pljson);
function get_version return varchar2;
end pljson_parser;
/
show err
-- ====================================================================
-- STEP 4: Creare package bodies si type implementations
-- ====================================================================
PROMPT [4/6] Creare package bodies si type implementations...;
-- --- pljson_parser.impl (body) ---
create or replace package body pljson_parser as
/*
Copyright (c) 2009 Jonas Krogsboell
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
*/
decimalpoint varchar2(1 char) := '.';
-- 1. perfomance optimal value (such as any of 200 - 500) for length of part s_clob in set_src_array
-- 2. 4000 byte limitation in select "substr(s.src, level, 1)" in set_src_array
buffer_amount number := 200;
procedure set_buffer_amount(amount pls_integer) as
begin
if amount > 0 and amount <= 4000 then
buffer_amount := amount;
end if;
end;
procedure set_src_array(s in out nocopy json_src) as
begin
-- calc length src one time after subtsr clob
s.src_len := length(s.src);
-- get collection of char - faster than substr in loop in pl\sql
-- it is necessary to remember about the limitation varchar2 - 4000 byte
select substr(s.src, level, 1)
bulk collect into s.src_array
from dual
connect by level <= s.src_len;
end;
function lengthcc(buf clob) return number as
offset number := 0;
len number := 0;
src varchar2(32767);
begin
while true loop
begin
src := dbms_lob.substr(buf, buffer_amount, offset+1);
exception
when ucs2_exception then
src := dbms_lob.substr(buf, buffer_amount-1, offset+1);
end;
exit when src is null;
len := len + length(src);
offset := offset + length2(src);
--dbms_output.put_line('offset = ' || offset || ' len = ' || len);
end loop;
return len;
end;
procedure update_decimalpoint as
begin
select substr(value, 1, 1)
into decimalpoint
from nls_session_parameters
where parameter = 'NLS_NUMERIC_CHARACTERS';
end update_decimalpoint;
/* type json_src is record (len number, offset number, src varchar2(32767), s_clob clob); */
/* assertions
offset: contains 0-base offset of buffer,
so 1-st entry is offset + 1, 4000-th entry = offset + 4000
src: contains offset + 1 .. offset + 4000, ex. 1..4000, 4001..8000, etc.
*/
function next_char(indx number, s in out nocopy json_src) return varchar2 as
begin
if (indx > s.len) then return null; end if;
--right offset?
/* if (indx > 4000 + s.offset or indx < s.offset) then */
/* fix for issue #37 */
/* code before fix for issue #169
if (indx > 4000 + s.offset or indx <= s.offset) then
s.offset := indx - (indx mod 4000);
-- addon fix for issue #37
if s.offset = indx then
s.offset := s.offset - 4000;
end if;
s.src := dbms_lob.substr(s.s_clob, 4000, s.offset+1);
end if;
--read from s.src
return substr(s.src, indx-s.offset, 1);
*/
/* use of length, so works correctly for 4-byte unicode characters (issue #169) */
/* lengthc does not work (issue #190) */
if (indx > s.src_len + s.offset_chars) then
while (indx > length(s.src) + s.offset_chars) loop
s.offset_chars := s.offset_chars + length(s.src);
s.offset := s.offset + length2(s.src);
/* exception check, so works correctly for 4-byte unicode characters (issue #169) */
begin
s.src := dbms_lob.substr(s.s_clob, buffer_amount, s.offset+1);
exception
when ucs2_exception then
s.src := dbms_lob.substr(s.s_clob, buffer_amount-1, s.offset+1);
end;
set_src_array(s);
end loop;
elsif (indx <= s.offset_chars) then
s.offset_chars := 0;
s.offset := 0;
/* exception check, so works correctly for 4-byte unicode characters (issue #169) */
begin
s.src := dbms_lob.substr(s.s_clob, buffer_amount, s.offset+1);
exception
when ucs2_exception then
s.src := dbms_lob.substr(s.s_clob, buffer_amount-1, s.offset+1);
end;
set_src_array(s);
while (indx > length(s.src) + s.offset_chars) loop
s.offset_chars := s.offset_chars + length(s.src);
s.offset := s.offset + length2(s.src);
/* exception check, so works correctly for 4-byte unicode characters (issue #169) */
begin
s.src := dbms_lob.substr(s.s_clob, buffer_amount, s.offset+1);
exception
when ucs2_exception then
s.src := dbms_lob.substr(s.s_clob, buffer_amount-1, s.offset+1);
end;
set_src_array(s);
end loop;
end if;
--dbms_output.put_line('indx: ' || indx || ' offset: ' || s.offset || ' (chars: ' || s.offset_chars || ') src chars: ' || length(s.src));
return s.src_array(indx-s.offset_chars);
end;
function next_char2(indx number, s in out nocopy json_src, amount number default 1) return varchar2 as
buf varchar2(32767) := '';
begin
for i in 1..amount loop
buf := buf || next_char(indx-1+i, s);
end loop;
return buf;
end;
function prepareClob(buf clob) return pljson_parser.json_src as
temp pljson_parser.json_src;
begin
temp.s_clob := buf;
temp.offset_chars := 0;
temp.offset := 0;
/* exception check, so works correctly for 4-byte unicode characters (issue #169) */
begin
temp.src := dbms_lob.substr(buf, buffer_amount, temp.offset+1);
exception
when ucs2_exception then
temp.src := dbms_lob.substr(buf, buffer_amount-1, temp.offset+1);
end;
/* use of lengthcc, so works correctly for 4-byte unicode characters (issue #169) */
temp.len := lengthcc(buf); --dbms_lob.getlength(buf);
set_src_array(temp);
return temp;
end;
function prepareVarchar2(buf varchar2) return pljson_parser.json_src as
temp pljson_parser.json_src;
begin
temp.s_clob := buf;
temp.offset_chars := 0;
temp.offset := 0;
temp.src := substr(buf, 1, buffer_amount);
temp.len := length(buf);
set_src_array(temp);
return temp;
end;
procedure debug(text varchar2) as
begin
dbms_output.put_line(text);
end;
procedure print_token(t rToken) as
begin
dbms_output.put_line('Line: '||t.line||' - Column: '||t.col||' - Type: '||t.type_name||' - Content: '||t.data);
end print_token;
/* SCANNER FUNCTIONS START */
procedure s_error(text varchar2, line number, col number) as
begin
raise_application_error(-20100, 'JSON Scanner exception @ line: '||line||' column: '||col||' - '||text);
end;
procedure s_error(text varchar2, tok rToken) as
begin
raise_application_error(-20100, 'JSON Scanner exception @ line: '||tok.line||' column: '||tok.col||' - '||text);
end;
function mt(t varchar2, l pls_integer, c pls_integer, d varchar2) return rToken as
token rToken;
begin
token.type_name := t;
token.line := l;
token.col := c;
token.data := d;
return token;
end;
function lexNumber(jsrc in out nocopy json_src, tok in out nocopy rToken, indx in out nocopy pls_integer) return pls_integer as
numbuf varchar2(4000) := '';
buf varchar2(4);
checkLoop boolean;
begin
buf := next_char(indx, jsrc);
if (buf = '-') then numbuf := '-'; indx := indx + 1; end if;
buf := next_char(indx, jsrc);
--0 or [1-9]([0-9])*
if (buf = '0') then
numbuf := numbuf || '0'; indx := indx + 1;
buf := next_char(indx, jsrc);
elsif (buf >= '1' and buf <= '9') then
numbuf := numbuf || buf; indx := indx + 1;
--read digits
buf := next_char(indx, jsrc);
while (buf >= '0' and buf <= '9') loop
numbuf := numbuf || buf; indx := indx + 1;
buf := next_char(indx, jsrc);
end loop;
end if;
--fraction
if (buf = '.') then
numbuf := numbuf || buf; indx := indx + 1;
buf := next_char(indx, jsrc);
checkLoop := FALSE;
while (buf >= '0' and buf <= '9') loop
checkLoop := TRUE;
numbuf := numbuf || buf; indx := indx + 1;
buf := next_char(indx, jsrc);
end loop;
if (not checkLoop) then
s_error('Expected: digits in fraction', tok);
end if;
end if;
--exp part
if (buf in ('e', 'E')) then
numbuf := numbuf || buf; indx := indx + 1;
buf := next_char(indx, jsrc);
if (buf = '+' or buf = '-') then
numbuf := numbuf || buf; indx := indx + 1;
buf := next_char(indx, jsrc);
end if;
checkLoop := FALSE;
while (buf >= '0' and buf <= '9') loop
checkLoop := TRUE;
numbuf := numbuf || buf; indx := indx + 1;
buf := next_char(indx, jsrc);
end loop;
if (not checkLoop) then
s_error('Expected: digits in exp', tok);
end if;
end if;
tok.data := numbuf;
return indx;
end lexNumber;
-- [a-zA-Z]([a-zA-Z0-9])*
function lexName(jsrc in out nocopy json_src, tok in out nocopy rToken, indx in out nocopy pls_integer) return pls_integer as
varbuf varchar2(32767) := '';
buf varchar(4);
num number;
begin
buf := next_char(indx, jsrc);
while (REGEXP_LIKE(buf, '^[[:alnum:]\_]$', 'i')) loop
varbuf := varbuf || buf;
indx := indx + 1;
buf := next_char(indx, jsrc);
if (buf is null) then
goto retname;
--debug('Premature string ending');
end if;
end loop;
<<retname>>
--could check for reserved keywords here
--debug(varbuf);
tok.data := varbuf;
return indx-1;
end lexName;
procedure updateClob(v_extended in out nocopy clob, v_str varchar2) as
begin
/* use of length2, so works correctly for 4-byte unicode characters (issue #169) */
dbms_lob.writeappend(v_extended, length2(v_str), v_str);
end updateClob;
function lexString(jsrc in out nocopy json_src, tok in out nocopy rToken, indx in out nocopy pls_integer, endChar char) return pls_integer as
v_extended clob := null; v_count number := 0;
varbuf varchar2(32767) := '';
buf varchar(4);
wrong boolean;
max_string_chars number := 5000; /* chunk size, less than this number may be copied */
begin
indx := indx + 1;
buf := next_char(indx, jsrc);
while (buf != endChar) loop
--clob control
if (v_count > 8191) then --crazy oracle error (16383 is the highest working length with unistr - 8192 choosen to be safe)
if (v_extended is null) then
v_extended := empty_clob();
dbms_lob.createtemporary(v_extended, true);
end if;
updateClob(v_extended, unistr(varbuf));
varbuf := ''; v_count := 0;
end if;
if (buf = Chr(13) or buf = CHR(9) or buf = CHR(10)) then
s_error('Control characters not allowed (CHR(9),CHR(10),CHR(13))', tok);
end if;
if (buf = '\') then
--varbuf := varbuf || buf;
indx := indx + 1;
buf := next_char(indx, jsrc);
case
when buf in ('\') then
varbuf := varbuf || buf || buf; v_count := v_count + 2;
indx := indx + 1;
buf := next_char(indx, jsrc);
when buf in ('"', '/') then
varbuf := varbuf || buf; v_count := v_count + 1;
indx := indx + 1;
buf := next_char(indx, jsrc);
when buf = '''' then
if (json_strict = false) then
varbuf := varbuf || buf; v_count := v_count + 1;
indx := indx + 1;
buf := next_char(indx, jsrc);
else
s_error('strictmode - expected: " \ / b f n r t u ', tok);
end if;
when buf in ('b', 'f', 'n', 'r', 't') then
--backspace b = U+0008
--formfeed f = U+000C
--newline n = U+000A
--carret r = U+000D
--tabulator t = U+0009
case buf
when 'b' then varbuf := varbuf || chr(8);
when 'f' then varbuf := varbuf || chr(12);
when 'n' then varbuf := varbuf || chr(10);
when 'r' then varbuf := varbuf || chr(13);
when 't' then varbuf := varbuf || chr(9);
end case;
--varbuf := varbuf || buf;
v_count := v_count + 1;
indx := indx + 1;
buf := next_char(indx, jsrc);
when buf = 'u' then
--four hexadecimal chars
declare
four varchar2(4);
begin
four := next_char2(indx+1, jsrc, 4);
wrong := FALSE;
if (upper(substr(four, 1, 1)) not in ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','a','b','c','d','e','f')) then wrong := TRUE; end if;
if (upper(substr(four, 2, 1)) not in ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','a','b','c','d','e','f')) then wrong := TRUE; end if;
if (upper(substr(four, 3, 1)) not in ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','a','b','c','d','e','f')) then wrong := TRUE; end if;
if (upper(substr(four, 4, 1)) not in ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','a','b','c','d','e','f')) then wrong := TRUE; end if;
if (wrong) then
s_error('expected: " \u([0-9][A-F]){4}', tok);
end if;
-- varbuf := varbuf || buf || four;
varbuf := varbuf || '\'||four;--chr(to_number(four,'XXXX'));
v_count := v_count + 5;
indx := indx + 5;
buf := next_char(indx, jsrc);
end;
else
s_error('expected: " \ / b f n r t u ', tok);
end case;
else
varbuf := varbuf || buf; v_count := v_count + 1;
indx := indx + 1;
buf := next_char(indx, jsrc);
end if;
end loop;
if (buf is null) then
s_error('string ending not found', tok);
--debug('Premature string ending');
end if;
--debug(varbuf);
--dbms_output.put_line(varbuf);
if (v_extended is not null) then
updateClob(v_extended, unistr(varbuf));
tok.data_overflow := v_extended;
-- tok.data := dbms_lob.substr(v_extended, 1, 32767);
/* may read less than "max_string_chars" characters but it's a sample so doesn't matter */
dbms_lob.read(v_extended, max_string_chars, 1, tok.data);
else
tok.data := unistr(varbuf);
end if;
return indx;
end lexString;
/* scanner tokens:
'{', '}', ',', ':', '[', ']', STRING, NUMBER, TRUE, FALSE, NULL
*/
function lexer(jsrc in out nocopy json_src) return lTokens as
tokens lTokens;
indx pls_integer := 1;
tok_indx pls_integer := 1;
buf varchar2(4);
lin_no number := 1;
col_no number := 0;
begin
while (indx <= jsrc.len) loop
--read into buf
buf := next_char(indx, jsrc);
col_no := col_no + 1;
--convert to switch case
case
when buf = '{' then tokens(tok_indx) := mt('{', lin_no, col_no, null); tok_indx := tok_indx + 1;
when buf = '}' then tokens(tok_indx) := mt('}', lin_no, col_no, null); tok_indx := tok_indx + 1;
when buf = ',' then tokens(tok_indx) := mt(',', lin_no, col_no, null); tok_indx := tok_indx + 1;
when buf = ':' then tokens(tok_indx) := mt(':', lin_no, col_no, null); tok_indx := tok_indx + 1;
when buf = '[' then tokens(tok_indx) := mt('[', lin_no, col_no, null); tok_indx := tok_indx + 1;
when buf = ']' then tokens(tok_indx) := mt(']', lin_no, col_no, null); tok_indx := tok_indx + 1;
when buf = 't' then
if (next_char2(indx, jsrc, 4) != 'true') then
if (json_strict = false and REGEXP_LIKE(buf, '^[[:alpha:]]$', 'i')) then
tokens(tok_indx) := mt('STRING', lin_no, col_no, null);
indx := lexName(jsrc, tokens(tok_indx), indx);
col_no := col_no + length(tokens(tok_indx).data) + 1;
tok_indx := tok_indx + 1;
else
s_error('Expected: ''true''', lin_no, col_no);
end if;
else
tokens(tok_indx) := mt('TRUE', lin_no, col_no, null); tok_indx := tok_indx + 1;
indx := indx + 3;
col_no := col_no + 3;
end if;
when buf = 'n' then
if (next_char2(indx, jsrc, 4) != 'null') then
if (json_strict = false and REGEXP_LIKE(buf, '^[[:alpha:]]$', 'i')) then
tokens(tok_indx) := mt('STRING', lin_no, col_no, null);
indx := lexName(jsrc, tokens(tok_indx), indx);
col_no := col_no + length(tokens(tok_indx).data) + 1;
tok_indx := tok_indx + 1;
else
s_error('Expected: ''null''', lin_no, col_no);
end if;
else
tokens(tok_indx) := mt('NULL', lin_no, col_no, null); tok_indx := tok_indx + 1;
indx := indx + 3;
col_no := col_no + 3;
end if;
when buf = 'f' then
if (next_char2(indx, jsrc, 5) != 'false') then
if (json_strict = false and REGEXP_LIKE(buf, '^[[:alpha:]]$', 'i')) then
tokens(tok_indx) := mt('STRING', lin_no, col_no, null);
indx := lexName(jsrc, tokens(tok_indx), indx);
col_no := col_no + length(tokens(tok_indx).data) + 1;
tok_indx := tok_indx + 1;
else
s_error('Expected: ''false''', lin_no, col_no);
end if;
else
tokens(tok_indx) := mt('FALSE', lin_no, col_no, null); tok_indx := tok_indx + 1;
indx := indx + 4;
col_no := col_no + 4;
end if;
/* -- 9 = TAB, 10 = \n, 13 = \r (Linux = \n, Windows = \r\n, Mac = \r */
when (buf = Chr(10)) then --linux newlines
lin_no := lin_no + 1;
col_no := 0;
when (buf = Chr(13)) then --Windows or Mac way
lin_no := lin_no + 1;
col_no := 0;
if (jsrc.len >= indx+1) then -- better safe than sorry
buf := next_char(indx+1, jsrc);
if (buf = Chr(10)) then --\r\n
indx := indx + 1;
end if;
end if;
when (buf = CHR(9)) then null; --tabbing
when (buf in ('-', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9')) then --number
tokens(tok_indx) := mt('NUMBER', lin_no, col_no, null);
indx := lexNumber(jsrc, tokens(tok_indx), indx)-1;
col_no := col_no + length(tokens(tok_indx).data);
tok_indx := tok_indx + 1;
when buf = '"' then --string
tokens(tok_indx) := mt('STRING', lin_no, col_no, null);
indx := lexString(jsrc, tokens(tok_indx), indx, '"');
col_no := col_no + length(tokens(tok_indx).data) + 1;
tok_indx := tok_indx + 1;
when buf = '''' and json_strict = false then --string
tokens(tok_indx) := mt('STRING', lin_no, col_no, null);
indx := lexString(jsrc, tokens(tok_indx), indx, '''');
col_no := col_no + length(tokens(tok_indx).data) + 1; --hovsa her
tok_indx := tok_indx + 1;
when json_strict = false and REGEXP_LIKE(buf, '^[[:alpha:]]$', 'i') then
tokens(tok_indx) := mt('STRING', lin_no, col_no, null);
indx := lexName(jsrc, tokens(tok_indx), indx);
if (tokens(tok_indx).data_overflow is not null) then
/* use of lengthcc, so works correctly for 4-byte unicode characters (issue #169) */
col_no := col_no + lengthcc(tokens(tok_indx).data_overflow) + 1; --dbms_lob.getlength(tokens(tok_indx).data_overflow) + 1;
else
col_no := col_no + length(tokens(tok_indx).data) + 1;
end if;
tok_indx := tok_indx + 1;
when json_strict = false and buf||next_char(indx+1, jsrc) = '/*' then --strip comments
declare
saveindx number := indx;
un_esc clob;
begin
indx := indx + 1;
loop
indx := indx + 1;
buf := next_char(indx, jsrc)||next_char(indx+1, jsrc);
exit when buf = '*/';
exit when buf is null;
end loop;
if (indx = saveindx+2) then
--enter unescaped mode
--dbms_output.put_line('Entering unescaped mode');
un_esc := empty_clob();
dbms_lob.createtemporary(un_esc, true);
indx := indx + 1;
loop
indx := indx + 1;
buf := next_char(indx, jsrc)||next_char(indx+1, jsrc)||next_char(indx+2, jsrc)||next_char(indx+3, jsrc);
exit when buf = '/**/';
if buf is null then
s_error('Unexpected sequence /**/ to end unescaped data: '||buf, lin_no, col_no);
end if;
buf := next_char(indx, jsrc);
/* use of length2, so works correctly for 4-byte unicode characters (issue #169) */
dbms_lob.writeappend(un_esc, length2(buf), buf);
end loop;
tokens(tok_indx) := mt('ESTRING', lin_no, col_no, null);
tokens(tok_indx).data_overflow := un_esc;
/* use of lengthcc, so works correctly for 4-byte unicode characters (issue #169) */
col_no := col_no + lengthcc(un_esc) + 1; --dbms_lob.getlength(un_esc) + 1; --note: line count won't work properly
tok_indx := tok_indx + 1;
indx := indx + 2;
end if;
indx := indx + 1;
end;
when buf = ' ' then null; --space
else
s_error('Unexpected char: '||buf, lin_no, col_no);
end case;
indx := indx + 1;
end loop;
return tokens;
end lexer;
/* SCANNER END */
/* PARSER FUNCTIONS START */
procedure p_error(text varchar2, tok rToken) as
begin
raise_application_error(-20101, 'JSON Parser exception @ line: '||tok.line||' column: '||tok.col||' - '||text);
end;
function parseArr(tokens lTokens, indx in out nocopy pls_integer) return pljson_list as
e_arr pljson_element_array := pljson_element_array();
ret_list pljson_list := pljson_list();
v_count number := 0;
tok rToken;
pv pljson_number;
begin
--value, value, value ]
if (indx > tokens.count) then p_error('more elements in array was excepted', tok); end if;
tok := tokens(indx);
while (tok.type_name != ']') loop
e_arr.extend;
v_count := v_count + 1;
case tok.type_name
when 'TRUE' then e_arr(v_count) := pljson_bool(true);
when 'FALSE' then e_arr(v_count) := pljson_bool(false);
when 'NULL' then e_arr(v_count) := pljson_null();
when 'STRING' then e_arr(v_count) := case when tok.data_overflow is not null then pljson_string(tok.data_overflow) else pljson_string(tok.data) end;
when 'ESTRING' then e_arr(v_count) := pljson_string(tok.data_overflow, false);
/* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */
--when 'NUMBER' then e_arr(v_count) := pljson_number(to_number(replace(tok.data, '.', decimalpoint)));
when 'NUMBER' then
pv := pljson_number(0);
pv.parse_number(replace(tok.data, '.', decimalpoint));
e_arr(v_count) := pv;
when '[' then
declare e_list pljson_list; begin
indx := indx + 1;
e_list := parseArr(tokens, indx);
e_arr(v_count) := e_list;
end;
when '{' then
indx := indx + 1;
e_arr(v_count) := parseObj(tokens, indx);
else
p_error('Expected a value', tok);
end case;
indx := indx + 1;
if (indx > tokens.count) then p_error('] not found', tok); end if;
tok := tokens(indx);
if (tok.type_name = ',') then --advance
indx := indx + 1;
if (indx > tokens.count) then p_error('more elements in array was excepted', tok); end if;
tok := tokens(indx);
if (tok.type_name = ']') then --premature exit
p_error('Premature exit in array', tok);
end if;
elsif (tok.type_name != ']') then --error
p_error('Expected , or ]', tok);
end if;
end loop;
ret_list.list_data := e_arr;
return ret_list;
end parseArr;
function parseMem(tokens lTokens, indx in out pls_integer, mem_name varchar2, mem_indx number) return pljson_element as
mem pljson_element;
tok rToken;
pv pljson_number;
begin
tok := tokens(indx);
case tok.type_name
when 'TRUE' then mem := pljson_bool(true);
when 'FALSE' then mem := pljson_bool(false);
when 'NULL' then mem := pljson_null();
when 'STRING' then mem := case when tok.data_overflow is not null then pljson_string(tok.data_overflow) else pljson_string(tok.data) end;
when 'ESTRING' then mem := pljson_string(tok.data_overflow, false);
/* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */
--when 'NUMBER' then mem := pljson_number(to_number(replace(tok.data, '.', decimalpoint)));
when 'NUMBER' then
pv := pljson_number(0);
pv.parse_number(replace(tok.data, '.', decimalpoint));
mem := pv;
when '[' then
declare
e_list pljson_list;
begin
indx := indx + 1;
e_list := parseArr(tokens, indx);
mem := e_list;
end;
when '{' then
indx := indx + 1;
mem := parseObj(tokens, indx);
else
p_error('Found '||tok.type_name, tok);
end case;
mem.mapname := mem_name;
mem.mapindx := mem_indx;
indx := indx + 1;
return mem;
end parseMem;
/*procedure test_duplicate_members(arr in json_member_array, mem_name in varchar2, wheretok rToken) as
begin
for i in 1 .. arr.count loop
if (arr(i).member_name = mem_name) then
p_error('Duplicate member name', wheretok);
end if;
end loop;
end test_duplicate_members;*/
function parseObj(tokens lTokens, indx in out nocopy pls_integer) return pljson as
type memmap is table of number index by varchar2(4000); -- i've read somewhere that this is not possible - but it is!
mymap memmap;
nullelemfound boolean := false;
obj pljson;
tok rToken;
mem_name varchar(4000);
arr pljson_element_array := pljson_element_array();
begin
--what to expect?
while (indx <= tokens.count) loop
tok := tokens(indx);
--debug('E: '||tok.type_name);
case tok.type_name
when 'STRING' then
--member
mem_name := substr(tok.data, 1, 4000);
begin
if (mem_name is null) then
if (nullelemfound) then
p_error('Duplicate empty member: ', tok);
else
nullelemfound := true;
end if;
elsif (mymap(mem_name) is not null) then
p_error('Duplicate member name: '||mem_name, tok);
end if;
exception
when no_data_found then mymap(mem_name) := 1;
end;
indx := indx + 1;
if (indx > tokens.count) then p_error('Unexpected end of input', tok); end if;
tok := tokens(indx);
indx := indx + 1;
if (indx > tokens.count) then p_error('Unexpected end of input', tok); end if;
if (tok.type_name = ':') then
--parse
declare
jmb pljson_element;
x number;
begin
x := arr.count + 1;
jmb := parseMem(tokens, indx, mem_name, x);
arr.extend;
arr(x) := jmb;
end;
else
p_error('Expected '':''', tok);
end if;
--move indx forward if ',' is found
if (indx > tokens.count) then p_error('Unexpected end of input', tok); end if;
tok := tokens(indx);
if (tok.type_name = ',') then
--debug('found ,');
indx := indx + 1;
tok := tokens(indx);
if (tok.type_name = '}') then --premature exit
p_error('Premature exit in json object', tok);
end if;
elsif (tok.type_name != '}') then
p_error('A comma seperator is probably missing', tok);
end if;
when '}' then
obj := pljson();
obj.json_data := arr;
return obj;
else
p_error('Expected string or }', tok);
end case;
end loop;
p_error('} not found', tokens(indx-1));
return obj;
end;
function parser(str varchar2) return pljson as
tokens lTokens;
obj pljson;
indx pls_integer := 1;
jsrc json_src;
begin
--update_decimalpoint();
jsrc := prepareVarchar2(str);
tokens := lexer(jsrc);
if (tokens(indx).type_name = '{') then
indx := indx + 1;
obj := parseObj(tokens, indx);
else
raise_application_error(-20101, 'JSON Parser exception - no { start found');
end if;
if (tokens.count != indx) then
p_error('} should end the JSON object', tokens(indx));
end if;
return obj;
end parser;
function parse_list(str varchar2) return pljson_list as
tokens lTokens;
obj pljson_list;
indx pls_integer := 1;
jsrc json_src;
begin
--update_decimalpoint();
jsrc := prepareVarchar2(str);
tokens := lexer(jsrc);
if (tokens(indx).type_name = '[') then
indx := indx + 1;
obj := parseArr(tokens, indx);
else
raise_application_error(-20101, 'JSON List Parser exception - no [ start found');
end if;
if (tokens.count != indx) then
p_error('] should end the JSON List object', tokens(indx));
end if;
return obj;
end parse_list;
function parse_list(str clob) return pljson_list as
tokens lTokens;
obj pljson_list;
indx pls_integer := 1;
jsrc json_src;
begin
--update_decimalpoint();
jsrc := prepareClob(str);
tokens := lexer(jsrc);
if (tokens(indx).type_name = '[') then
indx := indx + 1;
obj := parseArr(tokens, indx);
else
raise_application_error(-20101, 'JSON List Parser exception - no [ start found');
end if;
if (tokens.count != indx) then
p_error('] should end the JSON List object', tokens(indx));
end if;
return obj;
end parse_list;
function parser(str clob) return pljson as
tokens lTokens;
obj pljson;
indx pls_integer := 1;
jsrc json_src;
begin
--update_decimalpoint();
--dbms_output.put_line('Using clob');
jsrc := prepareClob(str);
tokens := lexer(jsrc);
if (tokens(indx).type_name = '{') then
indx := indx + 1;
obj := parseObj(tokens, indx);
else
raise_application_error(-20101, 'JSON Parser exception - no { start found');
end if;
if (tokens.count != indx) then
p_error('} should end the JSON object', tokens(indx));
end if;
return obj;
end parser;
function parse_any(str varchar2) return pljson_element as
tokens lTokens;
obj pljson_list;
ret pljson_element;
indx pls_integer := 1;
jsrc json_src;
begin
--update_decimalpoint();
jsrc := prepareVarchar2(str);
tokens := lexer(jsrc);
tokens(tokens.count+1).type_name := ']';
obj := parseArr(tokens, indx);
if (tokens.count != indx) then
p_error('] should end the JSON List object', tokens(indx));
end if;
return obj.head();
end parse_any;
function parse_any(str clob) return pljson_element as
tokens lTokens;
obj pljson_list;
indx pls_integer := 1;
jsrc json_src;
begin
--update_decimalpoint();
jsrc := prepareClob(str);
tokens := lexer(jsrc);
tokens(tokens.count+1).type_name := ']';
obj := parseArr(tokens, indx);
if (tokens.count != indx) then
p_error('] should end the JSON List object', tokens(indx));
end if;
return obj.head();
end parse_any;
/* last entry is the one to keep */
procedure remove_duplicates(obj in out nocopy pljson) as
type memberlist is table of pljson_element index by varchar2(4000);
members memberlist;
nulljsonvalue pljson_element := null;
validated pljson := pljson();
indx varchar2(4000);
begin
for i in 1 .. obj.count loop
if (obj.get(i).mapname is null) then
nulljsonvalue := obj.get(i);
else
members(obj.get(i).mapname) := obj.get(i);
end if;
end loop;
validated.check_duplicate(false);
indx := members.first;
loop
exit when indx is null;
validated.put(indx, members(indx));
indx := members.next(indx);
end loop;
if (nulljsonvalue is not null) then
validated.put('', nulljsonvalue);
end if;
validated.check_for_duplicate := obj.check_for_duplicate;
obj := validated;
end;
function get_version return varchar2 as
begin
return 'PL/JSON {{PLJSON_VERSION}}';
end get_version;
begin
update_decimalpoint();
end pljson_parser;
/
show err
-- --- pljson_printer.package (spec + body) ---
create or replace package pljson_printer as
/*
Copyright (c) 2010 Jonas Krogsboell
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
*/
indent_string varchar2(10 char) := ' '; --chr(9); for tab
newline_char varchar2(2 char) := chr(13)||chr(10); -- Windows style
--newline_char varchar2(2) := chr(10); -- Mac style
--newline_char varchar2(2) := chr(13); -- Linux style
ascii_output boolean not null := true;
empty_string_as_null boolean not null := false;
escape_solidus boolean not null := false;
unescaped_string_delim varchar2(10 char) := '/**/';
function pretty_print(obj pljson, spaces boolean default true, line_length number default 0) return varchar2;
function pretty_print_list(obj pljson_list, spaces boolean default true, line_length number default 0) return varchar2;
function pretty_print_any(json_part pljson_element, spaces boolean default true, line_length number default 0) return varchar2;
procedure pretty_print(obj pljson, spaces boolean default true, buf in out nocopy clob, line_length number default 0, erase_clob boolean default true);
procedure pretty_print_list(obj pljson_list, spaces boolean default true, buf in out nocopy clob, line_length number default 0, erase_clob boolean default true);
procedure pretty_print_any(json_part pljson_element, spaces boolean default true, buf in out nocopy clob, line_length number default 0, erase_clob boolean default true);
procedure dbms_output_clob(my_clob clob, delim varchar2, jsonp varchar2 default null);
procedure htp_output_clob(my_clob clob, jsonp varchar2 default null);
-- made public just for testing/profiling...
function escapeString(str varchar2) return varchar2;
end pljson_printer;
/
show err
create or replace package body pljson_printer as
max_line_len number := 0;
cur_line_len number := 0;
-- associative array used inside escapeString to cache the escaped version of every character
-- escaped so far (example: char_map('"') contains the '\"' string)
-- (if the character does not need to be escaped, the character is stored unchanged in the array itself)
-- type Rmap_char is record(buf varchar2(40), len integer);
type Tmap_char_string is table of varchar2(40) index by varchar2(1 char); /* index by unicode char */
char_map Tmap_char_string;
-- since char_map the associative array is a global variable reused across multiple calls to escapeString,
-- i need to be able to detect that the escape_solidus or ascii_output global parameters have been changed,
-- in order to clear it and avoid using escape sequences that have been cached using the previous values
char_map_escape_solidus boolean := escape_solidus;
char_map_ascii_output boolean := ascii_output;
function llcheck(str in varchar2) return varchar2 as
begin
--dbms_output.put_line(cur_line_len || ' : ' || str);
if (max_line_len > 0 and length(str)+cur_line_len > max_line_len) then
cur_line_len := length(str);
return newline_char || str;
else
cur_line_len := cur_line_len + length(str);
return str;
end if;
end llcheck;
-- escapes a single character.
function escapeChar(ch char) return varchar2 deterministic is
result varchar2(20);
begin
--backspace b = U+0008
--formfeed f = U+000C
--newline n = U+000A
--carret r = U+000D
--tabulator t = U+0009
result := ch;
case ch
when chr( 8) then result := '\b';
when chr( 9) then result := '\t';
when chr(10) then result := '\n';
when chr(12) then result := '\f';
when chr(13) then result := '\r';
when chr(34) then result := '\"';
when chr(47) then if (escape_solidus) then result := '\/'; end if;
when chr(92) then result := '\\';
/* WARNING: ascii() returns PLS_INTEGER and large unicode code points can be negative */
else if (ascii(ch) >= 0 and ascii(ch) < 32) then
result := '\u' || replace(substr(to_char(ascii(ch), 'XXXX'), 2, 4), ' ', '0');
elsif (ascii_output) then
result := replace(asciistr(ch), '\', '\u');
end if;
end case;
return result;
end;
function escapeString(str varchar2) return varchar2 as
sb varchar2(32767 byte) := '';
buf varchar2(40);
ch varchar2(1 char); /* unicode char */
begin
if (str is null) then return ''; end if;
-- clear the cache if global parameters have been changed
if char_map_escape_solidus <> escape_solidus or
char_map_ascii_output <> ascii_output
then
char_map.delete;
char_map_escape_solidus := escape_solidus;
char_map_ascii_output := ascii_output;
end if;
for i in 1 .. length(str) loop
ch := substr(str, i, 1 ) ;
begin
-- it this char has already been processed, I have cached its escaped value
buf:=char_map(ch);
exception when no_Data_found then
-- otherwise, i convert the value and add it to the cache
buf := escapeChar(ch);
char_map(ch) := buf;
end;
sb := sb || buf;
end loop;
return sb;
end escapeString;
function newline(spaces boolean) return varchar2 as
begin
cur_line_len := 0;
if (spaces) then return newline_char; else return ''; end if;
end;
/* function get_schema return varchar2 as
begin
return sys_context('userenv', 'current_schema');
end;
*/
function tab(indent number, spaces boolean) return varchar2 as
i varchar(200) := '';
begin
if (not spaces) then return ''; end if;
for x in 1 .. indent loop i := i || indent_string; end loop;
return i;
end;
function string_delim(elem pljson_string) return varchar2 as
begin
return
case when elem.num = 1 then '"'
else
case when elem.unescaped_string_delim_p = 1 then elem.unescaped_string_delim
else pljson_printer.unescaped_string_delim
end
end;
end;
function getCommaSep(spaces boolean) return varchar2 as
begin
if (spaces) then return ', '; else return ','; end if;
end;
function getMemName(mem pljson_element, spaces boolean) return varchar2 as
begin
if (spaces) then
return llcheck('"'||escapeString(mem.mapname)||'"') || llcheck(' : ');
else
return llcheck('"'||escapeString(mem.mapname)||'"') || llcheck(':');
end if;
end;
/* clob methods begin */
procedure add_to_clob(buf_lob in out nocopy clob, buf_str in out nocopy varchar2, str varchar2) as
begin
-- if (length(str) > 5000 - length(buf_str)) then
if (lengthb(str) > 32767 - lengthb(buf_str)) then
-- dbms_lob.writeappend(buf_lob, length2(buf_str), buf_str);
dbms_lob.append(buf_lob, buf_str);
buf_str := str;
else
buf_str := buf_str || str;
end if;
end add_to_clob;
procedure flush_clob(buf_lob in out nocopy clob, buf_str in out nocopy varchar2) as
begin
-- dbms_lob.writeappend(buf_lob, length2(buf_str), buf_str);
dbms_lob.append(buf_lob, buf_str);
end flush_clob;
procedure ppObj(obj pljson, indent number, buf in out nocopy clob, spaces boolean, buf_str in out nocopy varchar2);
procedure ppString(elem pljson_string, buf in out nocopy clob, buf_str in out nocopy varchar2) is
offset number := 1;
/* E.I.Sarmas (github.com/dsnz) 2016-01-21 limit to 5000 chars */
v_str varchar(5000 char);
amount number := 5000; /* chunk size for use in escapeString, less than this number may be copied */
begin
if empty_string_as_null and elem.extended_str is null and elem.str is null then
add_to_clob(buf, buf_str, 'null');
else
add_to_clob(buf, buf_str, string_delim(elem));
if (elem.extended_str is not null) then --clob implementation
while (offset <= dbms_lob.getlength(elem.extended_str)) loop
dbms_lob.read(elem.extended_str, amount, offset, v_str);
if (elem.num = 1) then
add_to_clob(buf, buf_str, escapeString(v_str));
else
add_to_clob(buf, buf_str, v_str);
end if;
offset := offset + amount;
end loop;
else
if (elem.num = 1) then
while (offset <= length(elem.str)) loop
v_str:=substr(elem.str, offset, amount);
add_to_clob(buf, buf_str, escapeString(v_str));
offset := offset + amount;
end loop;
else
add_to_clob(buf, buf_str, elem.str);
end if;
end if;
add_to_clob(buf, buf_str, string_delim(elem));
end if;
end;
procedure ppEA(input pljson_list, indent number, buf in out nocopy clob, spaces boolean, buf_str in out nocopy varchar2) as
elem pljson_element;
arr pljson_element_array := input.list_data;
numbuf varchar2(4000);
begin
for y in 1 .. arr.count loop
elem := arr(y);
if (elem is not null) then
case elem.typeval
/* number */
when 4 then
numbuf := treat(elem as pljson_number).number_toString();
add_to_clob(buf, buf_str, llcheck(numbuf));
/* string */
when 3 then
ppString(treat(elem as pljson_string), buf, buf_str);
/* bool */
when 5 then
if (elem.get_bool()) then
add_to_clob(buf, buf_str, llcheck('true'));
else
add_to_clob(buf, buf_str, llcheck('false'));
end if;
/* null */
when 6 then
add_to_clob(buf, buf_str, llcheck('null'));
/* array */
when 2 then
add_to_clob(buf, buf_str, llcheck('['));
ppEA(treat(elem as pljson_list), indent, buf, spaces, buf_str);
add_to_clob(buf, buf_str, llcheck(']'));
/* object */
when 1 then
ppObj(treat(elem as pljson), indent, buf, spaces, buf_str);
else
add_to_clob(buf, buf_str, llcheck(elem.get_type));
end case;
end if;
if (y != arr.count) then add_to_clob(buf, buf_str, llcheck(getCommaSep(spaces))); end if;
end loop;
end ppEA;
procedure ppMem(mem pljson_element, indent number, buf in out nocopy clob, spaces boolean, buf_str in out nocopy varchar2) as
numbuf varchar2(4000);
begin
add_to_clob(buf, buf_str, llcheck(tab(indent, spaces)) || llcheck(getMemName(mem, spaces)));
case mem.typeval
/* number */
when 4 then
numbuf := treat(mem as pljson_number).number_toString();
add_to_clob(buf, buf_str, llcheck(numbuf));
/* string */
when 3 then
ppString(treat(mem as pljson_string), buf, buf_str);
/* bool */
when 5 then
if (mem.get_bool()) then
add_to_clob(buf, buf_str, llcheck('true'));
else
add_to_clob(buf, buf_str, llcheck('false'));
end if;
/* null */
when 6 then
add_to_clob(buf, buf_str, llcheck('null'));
/* array */
when 2 then
add_to_clob(buf, buf_str, llcheck('['));
ppEA(treat(mem as pljson_list), indent, buf, spaces, buf_str);
add_to_clob(buf, buf_str, llcheck(']'));
/* object */
when 1 then
ppObj(treat(mem as pljson), indent, buf, spaces, buf_str);
else
add_to_clob(buf, buf_str, llcheck(mem.get_type));
end case;
end ppMem;
procedure ppObj(obj pljson, indent number, buf in out nocopy clob, spaces boolean, buf_str in out nocopy varchar2) as
begin
add_to_clob(buf, buf_str, llcheck('{') || newline(spaces));
for m in 1 .. obj.json_data.count loop
ppMem(obj.json_data(m), indent+1, buf, spaces, buf_str);
if (m != obj.json_data.count) then
add_to_clob(buf, buf_str, llcheck(',') || newline(spaces));
else
add_to_clob(buf, buf_str, newline(spaces));
end if;
end loop;
add_to_clob(buf, buf_str, llcheck(tab(indent, spaces)) || llcheck('}')); -- || chr(13);
end ppObj;
procedure pretty_print(obj pljson, spaces boolean default true, buf in out nocopy clob, line_length number default 0, erase_clob boolean default true) as
buf_str varchar2(32767);
amount number := dbms_lob.getlength(buf);
begin
if (erase_clob and amount > 0) then
dbms_lob.trim(buf, 0);
-- dbms_lob.erase(buf, amount);
end if;
max_line_len := line_length;
cur_line_len := 0;
ppObj(obj, 0, buf, spaces, buf_str);
flush_clob(buf, buf_str);
end;
procedure pretty_print_list(obj pljson_list, spaces boolean default true, buf in out nocopy clob, line_length number default 0, erase_clob boolean default true) as
buf_str varchar2(32767);
amount number := dbms_lob.getlength(buf);
begin
if (erase_clob and amount > 0) then
dbms_lob.trim(buf, 0);
-- dbms_lob.erase(buf, amount);
end if;
max_line_len := line_length;
cur_line_len := 0;
add_to_clob(buf, buf_str, llcheck('['));
ppEA(obj, 0, buf, spaces, buf_str);
add_to_clob(buf, buf_str, llcheck(']'));
flush_clob(buf, buf_str);
end;
procedure pretty_print_any(json_part pljson_element, spaces boolean default true, buf in out nocopy clob, line_length number default 0, erase_clob boolean default true) as
buf_str varchar2(32767) := '';
numbuf varchar2(4000);
amount number := dbms_lob.getlength(buf);
begin
if (erase_clob and amount > 0) then
dbms_lob.trim(buf, 0);
-- dbms_lob.erase(buf, amount);
end if;
case json_part.typeval
/* number */
when 4 then
numbuf := treat(json_part as pljson_number).number_toString();
add_to_clob(buf, buf_str, numbuf);
/* string */
when 3 then
ppString(treat(json_part as pljson_string), buf, buf_str);
/* bool */
when 5 then
if (json_part.get_bool()) then
add_to_clob(buf, buf_str, 'true');
else
add_to_clob(buf, buf_str, 'false');
end if;
/* null */
when 6 then
add_to_clob(buf, buf_str, 'null');
/* array */
when 2 then
pretty_print_list(pljson_list(json_part), spaces, buf, line_length, erase_clob);
return;
/* object */
when 1 then
pretty_print(pljson(json_part), spaces, buf, line_length, erase_clob);
return;
else
add_to_clob(buf, buf_str, 'unknown type:' || json_part.get_type);
end case;
flush_clob(buf, buf_str);
end;
/* clob methods end */
/* varchar2 methods begin */
procedure add_buf (buf in out nocopy varchar2, str in varchar2) as
begin
if (lengthb(str)>32767-lengthb(buf)) then
raise_application_error(-20001,'Length of result JSON more than 32767 bytes. Use to_clob() procedures');
end if;
buf := buf || str;
end;
procedure ppString(elem pljson_string, buf in out nocopy varchar2) is
offset number := 1;
/* E.I.Sarmas (github.com/dsnz) 2016-01-21 limit to 5000 chars */
v_str varchar(5000 char);
amount number := 5000; /* chunk size for use in escapeString, less than this number may be copied */
begin
if empty_string_as_null and elem.extended_str is null and elem.str is null then
add_buf(buf, 'null');
else
add_buf(buf, string_delim(elem));
if (elem.extended_str is not null) then --clob implementation
while (offset <= dbms_lob.getlength(elem.extended_str)) loop
dbms_lob.read(elem.extended_str, amount, offset, v_str);
if (elem.num = 1) then
add_buf(buf, escapeString(v_str));
else
add_buf(buf, v_str);
end if;
offset := offset + amount;
end loop;
else
if (elem.num = 1) then
while (offset <= length(elem.str)) loop
v_str:=substr(elem.str, offset, amount);
add_buf(buf, escapeString(v_str));
offset := offset + amount;
end loop;
else
add_buf(buf, elem.str);
end if;
end if;
add_buf(buf, string_delim(elem));
end if;
end;
procedure ppObj(obj pljson, indent number, buf in out nocopy varchar2, spaces boolean);
procedure ppEA(input pljson_list, indent number, buf in out varchar2, spaces boolean) as
elem pljson_element;
arr pljson_element_array := input.list_data;
str varchar2(400);
begin
for y in 1 .. arr.count loop
elem := arr(y);
if (elem is not null) then
case elem.typeval
/* number */
when 4 then
str := treat(elem as pljson_number).number_toString();
add_buf(buf, llcheck(str));
/* string */
when 3 then
ppString(treat(elem as pljson_string), buf);
/* bool */
when 5 then
if (elem.get_bool()) then
add_buf (buf, llcheck('true'));
else
add_buf (buf, llcheck('false'));
end if;
/* null */
when 6 then
add_buf (buf, llcheck('null'));
/* array */
when 2 then
add_buf( buf, llcheck('['));
ppEA(treat(elem as pljson_list), indent, buf, spaces);
add_buf( buf, llcheck(']'));
/* object */
when 1 then
ppObj(treat(elem as pljson), indent, buf, spaces);
else
add_buf (buf, llcheck(elem.get_type)); /* should never happen */
end case;
end if;
if (y != arr.count) then add_buf(buf, llcheck(getCommaSep(spaces))); end if;
end loop;
end ppEA;
procedure ppMem(mem pljson_element, indent number, buf in out nocopy varchar2, spaces boolean) as
str varchar2(400) := '';
begin
add_buf(buf, llcheck(tab(indent, spaces)) || getMemName(mem, spaces));
case mem.typeval
/* number */
when 4 then
str := treat(mem as pljson_number).number_toString();
add_buf(buf, llcheck(str));
/* string */
when 3 then
ppString(treat(mem as pljson_string), buf);
/* bool */
when 5 then
if (mem.get_bool()) then
add_buf(buf, llcheck('true'));
else
add_buf(buf, llcheck('false'));
end if;
/* null */
when 6 then
add_buf(buf, llcheck('null'));
/* array */
when 2 then
add_buf(buf, llcheck('['));
ppEA(treat(mem as pljson_list), indent, buf, spaces);
add_buf(buf, llcheck(']'));
/* object */
when 1 then
ppObj(treat(mem as pljson), indent, buf, spaces);
else
add_buf(buf, llcheck(mem.get_type)); /* should never happen */
end case;
end ppMem;
procedure ppObj(obj pljson, indent number, buf in out nocopy varchar2, spaces boolean) as
begin
add_buf (buf, llcheck('{') || newline(spaces));
for m in 1 .. obj.json_data.count loop
ppMem(obj.json_data(m), indent+1, buf, spaces);
if (m != obj.json_data.count) then
add_buf(buf, llcheck(',') || newline(spaces));
else
add_buf(buf, newline(spaces));
end if;
end loop;
add_buf(buf, llcheck(tab(indent, spaces)) || llcheck('}')); -- || chr(13);
end ppObj;
function pretty_print(obj pljson, spaces boolean default true, line_length number default 0) return varchar2 as
buf varchar2(32767 byte) := '';
begin
max_line_len := line_length;
cur_line_len := 0;
ppObj(obj, 0, buf, spaces);
return buf;
end pretty_print;
function pretty_print_list(obj pljson_list, spaces boolean default true, line_length number default 0) return varchar2 as
buf varchar2(32767 byte) :='';
begin
max_line_len := line_length;
cur_line_len := 0;
add_buf(buf, llcheck('['));
ppEA(obj, 0, buf, spaces);
add_buf(buf, llcheck(']'));
return buf;
end;
function pretty_print_any(json_part pljson_element, spaces boolean default true, line_length number default 0) return varchar2 as
buf varchar2(32767) := '';
begin
case json_part.typeval
/* number */
when 4 then
buf := treat(json_part as pljson_number).number_toString();
/* string */
when 3 then
ppString(treat(json_part as pljson_string), buf);
/* bool */
when 5 then
if (json_part.get_bool()) then buf := 'true'; else buf := 'false'; end if;
/* null */
when 6 then
buf := 'null';
/* array */
when 2 then
buf := pretty_print_list(pljson_list(json_part), spaces, line_length);
/* object */
when 1 then
buf := pretty_print(pljson(json_part), spaces, line_length);
else
buf := 'weird error: ' || json_part.get_type;
end case;
return buf;
end;
/* varchar2 methods end */
procedure dbms_output_clob(my_clob clob, delim varchar2, jsonp varchar2 default null) as
prev number := 1;
indx number := 1;
size_of_nl number := length2(delim);
v_str varchar2(32767);
amount number;
max_string_chars number := 5000; /* chunk size, less than this number may be copied */
begin
if (jsonp is not null) then dbms_output.put_line(jsonp||'('); end if;
while (indx != 0) loop
--read every line
indx := dbms_lob.instr(my_clob, delim, prev+1);
--dbms_output.put_line(prev || ' to ' || indx);
if (indx = 0) then
--emit from prev to end;
amount := max_string_chars;
--dbms_output.put_line(' mycloblen ' || dbms_lob.getlength(my_clob));
loop
dbms_lob.read(my_clob, amount, prev, v_str);
dbms_output.put_line(v_str);
prev := prev+amount;
exit when prev >= dbms_lob.getlength(my_clob);
end loop;
else
amount := indx - prev;
if (amount > max_string_chars) then
amount := max_string_chars;
--dbms_output.put_line(' mycloblen ' || dbms_lob.getlength(my_clob));
loop
dbms_lob.read(my_clob, amount, prev, v_str);
dbms_output.put_line(v_str);
prev := prev+amount;
amount := indx - prev;
exit when prev >= indx - 1;
if (amount > max_string_chars) then
amount := max_string_chars;
end if;
end loop;
prev := indx + size_of_nl;
else
dbms_lob.read(my_clob, amount, prev, v_str);
dbms_output.put_line(v_str);
prev := indx + size_of_nl;
end if;
end if;
end loop;
if (jsonp is not null) then dbms_output.put_line(')'); end if;
/* while (amount != 0) loop
indx := dbms_lob.instr(my_clob, delim, prev+1);
-- dbms_output.put_line(prev || ' to ' || indx);
if (indx = 0) then
indx := dbms_lob.getlength(my_clob)+1;
end if;
if (indx-prev > 32767) then
indx := prev+32767;
end if;
-- dbms_output.put_line(prev || ' to ' || indx);
--substr doesnt work properly on all platforms! (come on oracle - error on Oracle VM for virtualbox)
-- dbms_output.put_line(dbms_lob.substr(my_clob, indx-prev, prev));
amount := indx-prev;
-- dbms_output.put_line('amount'||amount);
dbms_lob.read(my_clob, amount, prev, v_str);
dbms_output.put_line(v_str);
prev := indx+size_of_nl;
if (amount = 32767) then prev := prev-size_of_nl-1; end if;
end loop;
if (jsonp is not null) then dbms_output.put_line(')'); end if;*/
end;
/*
procedure dbms_output_clob(my_clob clob, delim varchar2, jsonp varchar2 default null) as
prev number := 1;
indx number := 1;
size_of_nl number := length2(delim);
v_str varchar2(32767);
amount number;
begin
if (jsonp is not null) then dbms_output.put_line(jsonp||'('); end if;
while (indx != 0) loop
indx := dbms_lob.instr(my_clob, delim, prev+1);
--dbms_output.put_line(prev || ' to ' || indx);
if (indx-prev > 32767) then
indx := prev+32767;
end if;
--dbms_output.put_line(prev || ' to ' || indx);
--substr doesnt work properly on all platforms! (come on oracle - error on Oracle VM for virtualbox)
if (indx = 0) then
--dbms_output.put_line(dbms_lob.substr(my_clob, dbms_lob.getlength(my_clob)-prev+size_of_nl, prev));
amount := dbms_lob.getlength(my_clob)-prev+size_of_nl;
dbms_lob.read(my_clob, amount, prev, v_str);
else
--dbms_output.put_line(dbms_lob.substr(my_clob, indx-prev, prev));
amount := indx-prev;
--dbms_output.put_line('amount'||amount);
dbms_lob.read(my_clob, amount, prev, v_str);
end if;
dbms_output.put_line(v_str);
prev := indx+size_of_nl;
if (amount = 32767) then prev := prev-size_of_nl-1; end if;
end loop;
if (jsonp is not null) then dbms_output.put_line(')'); end if;
end;
*/
procedure htp_output_clob(my_clob clob, jsonp varchar2 default null) as
/*amount number := 4096;
pos number := 1;
len number;
*/
l_amt number default 4096;
l_off number default 1;
l_str varchar2(32000);
begin
if (jsonp is not null) then htp.prn(jsonp||'('); end if;
begin
loop
dbms_lob.read( my_clob, l_amt, l_off, l_str );
-- it is vital to use htp.PRN to avoid
-- spurious line feeds getting added to your
-- document
htp.prn( l_str );
l_off := l_off+l_amt;
end loop;
exception
when no_data_found then NULL;
end;
/*
len := dbms_lob.getlength(my_clob);
while (pos < len) loop
htp.prn(dbms_lob.substr(my_clob, amount, pos)); -- should I replace substr with dbms_lob.read?
--dbms_output.put_line(dbms_lob.substr(my_clob, amount, pos));
pos := pos + amount;
end loop;
*/
if (jsonp is not null) then htp.prn(')'); end if;
end;
end pljson_printer;
/
show err
-- --- pljson_ext.impl (body) ---
create or replace package body pljson_ext as
/*
Copyright (c) 2009 Jonas Krogsboell
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
*/
scanner_exception exception;
pragma exception_init(scanner_exception, -20100);
parser_exception exception;
pragma exception_init(parser_exception, -20101);
jext_exception exception;
pragma exception_init(jext_exception, -20110);
--extra function checks if number has no fraction
function is_integer(v pljson_element) return boolean as
num number;
num_double binary_double;
int_number number(38); --the oracle way to specify an integer
int_double binary_double; --the oracle way to specify an integer
begin
/*
if (v.is_number()) then
myint := v.get_number();
return (myint = v.get_number()); --no rounding errors?
else
return false;
end if;
*/
if (not v.is_number()) then
raise_application_error(-20109, 'not a number-value');
end if;
/* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */
if (v.is_number_repr_number()) then
num := v.get_number();
int_number := trunc(num);
--dbms_output.put_line('number: ' || num || ' -> ' || int_number);
return (int_number = num); --no rounding errors?
elsif (v.is_number_repr_double()) then
num_double := v.get_double();
int_double := trunc(num_double);
--dbms_output.put_line('double: ' || num_double || ' -> ' || int_double);
return (int_double = num_double); --no rounding errors?
else
return false;
end if;
end;
--extension enables json to store dates without compromising the implementation
function to_json_string(d date) return pljson_string as
begin
return pljson_string(to_char(d, format_string));
end;
--notice that a date type in json is also a varchar2
function is_date(v pljson_element) return boolean as
temp date;
begin
temp := pljson_ext.to_date(v);
return true;
exception
when others then
return false;
end;
--conversion is needed to extract dates
function to_date(v pljson_element) return date as
begin
if (v.is_string()) then
return standard.to_date(v.get_string(), format_string);
else
raise_application_error(-20110, 'not a date-value');
end if;
exception
when others then
raise_application_error(-20110, 'Anydata did not contain a date on the format: '||format_string);
end;
-- alias so that old code doesn't break
function to_date2(v pljson_element) return date as
begin
return to_date(v);
end;
/*
assumes single base64 string or broken into equal length lines of max 64 or 76 chars
(as specified by RFC-1421 or RFC-2045)
line ending can be CR+NL or NL
*/
function decodeBase64Clob2Blob(p_clob clob) return blob
is
r_blob blob;
clob_size number;
pos number;
c_buf varchar2(32767);
r_buf raw(32767);
v_read_size number;
v_line_size number;
begin
dbms_lob.createtemporary(r_blob, false, dbms_lob.call);
/*
E.I.Sarmas (github.com/dsnz) 2017-12-07 fix for alignment issues
assumes single base64 string or broken into equal length lines of max 64 or 76 followed by CR+NL
as specified by RFC-1421 or RFC-2045 which seem to be the supported ones by Oracle utl_encode
also support single NL instead of CR+NL !
*/
clob_size := dbms_lob.getlength(p_clob);
v_line_size := 64;
if clob_size >= 65 and dbms_lob.substr(p_clob, 1, 65) = chr(10) then
v_line_size := 65;
elsif clob_size >= 66 and dbms_lob.substr(p_clob, 1, 65) = chr(13) then
v_line_size := 66;
elsif clob_size >= 77 and dbms_lob.substr(p_clob, 1, 77) = chr(10) then
v_line_size := 77;
elsif clob_size >= 78 and dbms_lob.substr(p_clob, 1, 77) = chr(13) then
v_line_size := 78;
end if;
--dbms_output.put_line('decoding in multiples of ' || v_line_size);
v_read_size := floor(32767/v_line_size)*v_line_size;
pos := 1;
while (pos < clob_size) loop
dbms_lob.read(p_clob, v_read_size, pos, c_buf);
r_buf := utl_encode.base64_decode(utl_raw.cast_to_raw(c_buf));
dbms_lob.writeappend(r_blob, utl_raw.length(r_buf), r_buf);
pos := pos + v_read_size;
end loop;
return r_blob;
end decodeBase64Clob2Blob;
/*
encoding in lines of 64 chars ending with CR+NL
*/
function encodeBase64Blob2Clob(p_blob in blob) return clob
is
r_clob clob;
/* E.I.Sarmas (github.com/dsnz) 2017-12-07 NOTE: must be multiple of 48 !!! */
c_step number := 12000;
c_buf varchar2(32767);
begin
if p_blob is not null then
dbms_lob.createtemporary(r_clob, false, dbms_lob.call);
for i in 0 .. trunc((dbms_lob.getlength(p_blob) - 1)/c_step) loop
c_buf := utl_raw.cast_to_varchar2(utl_encode.base64_encode(dbms_lob.substr(p_blob, c_step, i * c_step + 1)));
/*
E.I.Sarmas (github.com/dsnz) 2017-12-07 fix for alignment issues
must output CR+NL at end always, so will align with the following block and can be decoded correctly
assumes ending in CR+NL
*/
if substr(c_buf, length(c_buf)) != chr(10) then
c_buf := c_buf || CHR(13) || CHR(10);
end if;
/*
dbms_output.put_line(
'l=' || length(c_buf) ||
' e=' || ascii(substr(c_buf, length(c_buf) - 1)) || ' ' || ascii(substr(c_buf, length(c_buf)))
);
*/
dbms_lob.writeappend(lob_loc => r_clob, amount => length(c_buf), buffer => c_buf);
end loop;
end if;
return r_clob;
end encodeBase64Blob2Clob;
--Json Path parser
/* E.I.Sarmas (github.com/dsnz) 2021-12-01 minor path enhancement and more correct enforcement of paths accepted */
/*
updated definition of json path expression syntax accepted by PLJSON
- a path may optionally begin with $ indicating the JSON object to be matched (root)
then it's followed by 0 or more path steps
each step can be an object step or an array step, depending on whether the context item represents a JSON object or a JSON array
- an object step is a period (.), sometimes read as "dot", followed by an object field name (object property name)
a field name must start with an uppercase or lowercase letter A to Z and contain only such letters or decimal digits (0-9),
or else it must be enclosed in double quotation marks (")
OR
a left bracket ([) followed by a a field name enclosed in single (') or double (") quotes, followed by a right bracket (])
- an array step is a left bracket ([) followed by a single numeric index, followed by a right bracket (])
array indexing is one-based (1, 2, 3,...)
examples:
$.store.book[0].title
$['store']['book'][0]['title']
in latest update
- an object step, beginning with dot (.), now accepts name within double quotes (")
- no longer accepts name beginning with, ending with and including spaces eg. 'd. a name .data'
- in past, after a dot (.) the field name could start with space or number
and include or end with any number of spaces
now this is not allowed, unquoted field names must begin with an alpha character or _
and contain only alphanumeric characters
- path expressions are now compatible with Oracle Basic SQL/JSON Path Expression Syntax
but excluding the optional filter expression and the optional function step at end
*/
function parsePath(json_path varchar2, base number default 1) return pljson_list as
build_path varchar2(32767) := '[';
buf varchar2(4);
endstring varchar2(1);
indx number := 1;
ret pljson_list;
procedure next_char as
begin
if (indx <= length(json_path)) then
buf := substr(json_path, indx, 1);
indx := indx + 1;
else
buf := null;
end if;
end;
--skip ws
procedure skipws as begin while (buf in (chr(9), chr(10), chr(13), ' ')) loop next_char; end loop; end;
begin
-- dbms_output.put_line('parse: ' || json_path);
-- handle null path and optional '$' at beginning
if json_path is null or substr(json_path, 1, 1) = '$' then
indx := 2;
next_char();
else
if substr(json_path, 1, 1) = '[' then
next_char();
else
buf := '.';
end if;
end if;
while (buf is not null) loop
-- dbms_output.put_line(build_path || ' + ' || buf);
if (buf = '.') then
next_char();
if (buf is null) then raise_application_error(-20110, 'JSON Path parse error: . is not a valid json_path end'); end if;
/* E.I.Sarmas (github.com/dsnz) 2021-10-31 removed space or number as acceptable character */
if (not regexp_like(buf, '^["[:alpha:]\_]+', 'c') ) then
-- dbms_output.put_line(build_path || ' + ' || buf);
raise_application_error(-20110, 'JSON Path parse error: alpha or _ character expected at position '||indx);
end if;
if (build_path != '[') then build_path := build_path || ','; end if;
build_path := build_path || '"';
/* E.I.Sarmas (github.com/dsnz) 2021-10-31 accept name with any characters quoted within "" after . */
if buf = '"' then
next_char();
while buf is not null and buf != '"' loop
build_path := build_path || buf;
next_char();
end loop;
if buf is null then
raise_application_error(-20110, 'JSON Path parse error: premature json_path end, missing ending "');
end if;
next_char();
else
/* E.I.Sarmas (github.com/dsnz) 2021-10-31 removed space as acceptable character */
while (regexp_like(buf, '^[[:alnum:]\_]+', 'c') ) loop
build_path := build_path || buf;
next_char();
end loop;
end if;
build_path := build_path || '"';
elsif (buf = '[') then
next_char();
skipws();
if (buf is null) then raise_application_error(-20110, 'JSON Path parse error: [ is not a valid json_path end'); end if;
-- array step
if (buf in ('1','2','3','4','5','6','7','8','9') or (buf = '0' and base = 0)) then
if (build_path != '[') then build_path := build_path || ','; end if;
while (buf in ('0','1','2','3','4','5','6','7','8','9')) loop
build_path := build_path || buf;
next_char();
end loop;
-- object step using [] syntax
elsif (regexp_like(buf, '^(\"|\'')', 'c')) then
endstring := buf;
if (build_path != '[') then build_path := build_path || ','; end if;
build_path := build_path || '"';
next_char();
if (buf is null) then raise_application_error(-20110, 'JSON Path parse error: premature json_path end'); end if;
while (buf != endstring) loop
build_path := build_path || buf;
next_char();
if (buf is null) then raise_application_error(-20110, 'JSON Path parse error: premature json_path end'); end if;
if (buf = '\') then
next_char();
build_path := build_path || '\' || buf;
next_char();
end if;
end loop;
build_path := build_path || '"';
next_char();
else
raise_application_error(-20110, 'JSON Path parse error: expected a string or a positive integer at '||indx);
end if;
skipws();
if (buf is null) then raise_application_error(-20110, 'JSON Path parse error: premature json_path end'); end if;
if (buf != ']') then raise_application_error(-20110, 'JSON Path parse error: no array ending found. found: '|| buf); end if;
next_char();
skipws();
/* E.I.Sarmas (github.com/dsnz) 2021-10-31 obsolete, repeats code after ".", handled by assuming a dummy "." at start
elsif (build_path = '[') then
if (not regexp_like(buf, '^[[:alnum:]\_ ]+', 'c') ) then
raise_application_error(-20110, 'JSON Path parse error: alpha-numeric character or space expected at position '||indx);
end if;
build_path := build_path || '"';
while (regexp_like(buf, '^[[:alnum:]\_ ]+', 'c') ) loop
build_path := build_path || buf;
next_char();
end loop;
build_path := build_path || '"';
*/
else
raise_application_error(-20110, 'JSON Path parse error: expected . or [ found '|| buf || ' at position '|| indx);
end if;
end loop;
build_path := build_path || ']';
build_path := replace(replace(replace(replace(replace(build_path, chr(9), '\t'), chr(10), '\n'), chr(13), '\f'), chr(8), '\b'), chr(14), '\r');
-- dbms_output.put_line('parse= ' || build_path);
ret := pljson_list(build_path);
if (base != 1) then
--fix base 0 to base 1
declare
elem pljson_element;
begin
for i in 1 .. ret.count loop
elem := ret.get(i);
if (elem.is_number()) then
ret.replace(i, elem.get_number()+1);
end if;
end loop;
end;
end if;
return ret;
end parsePath;
--JSON pre-parsed path getters
/* contributed by @asfernandes */
function get_json_element(obj pljson, path pljson_list) return pljson_element as
path_segments pljson_path := pljson_path();
ret pljson_element;
begin
if (path.count = 0) then
return obj;
end if;
for i in 1 .. path.count loop
path_segments.extend;
if (path.get(i).is_number()) then
path_segments(path_segments.count) := pljson_path_segment(path.get(i).get_number(), null);
else
path_segments(path_segments.count) := pljson_path_segment(null, path.get(i).get_string());
end if;
end loop;
obj.get_internal_path(path_segments, 1, ret);
return ret;
exception
when scanner_exception then raise;
when parser_exception then raise;
when jext_exception then raise;
when others then return null;
end get_json_element;
function get_string(obj pljson, path pljson_list) return varchar2 as
temp pljson_element;
begin
temp := get_json_element(obj, path);
if (temp is null or not temp.is_string()) then
return null;
else
return temp.get_string();
end if;
end;
function get_number(obj pljson, path pljson_list) return number as
temp pljson_element;
begin
temp := get_json_element(obj, path);
if (temp is null or not temp.is_number()) then
return null;
else
return temp.get_number();
end if;
end;
function get_double(obj pljson, path pljson_list) return binary_double as
temp pljson_element;
begin
temp := get_json_element(obj, path);
if (temp is null or not temp.is_number()) then
return null;
else
return temp.get_double();
end if;
end;
function get_json(obj pljson, path pljson_list) return pljson as
temp pljson_element;
begin
temp := get_json_element(obj, path);
if (temp is null or not temp.is_object()) then
return null;
else
return treat(temp as pljson);
end if;
end;
function get_json_list(obj pljson, path pljson_list) return pljson_list as
temp pljson_element;
begin
temp := get_json_element(obj, path);
if (temp is null or not temp.is_array()) then
return null;
else
return treat(temp as pljson_list);
end if;
end;
function get_bool(obj pljson, path pljson_list) return boolean as
temp pljson_element;
begin
temp := get_json_element(obj, path);
if (temp is null or not temp.is_bool()) then
return null;
else
return temp.get_bool();
end if;
end;
function get_date(obj pljson, path pljson_list) return date as
temp pljson_element;
begin
temp := get_json_element(obj, path);
if (temp is null or not is_date(temp)) then
return null;
else
return pljson_ext.to_date(temp);
end if;
end;
--JSON Path getters
--saved original code, in case of future bug troubleshooting
function get_json_element_original(obj pljson, v_path varchar2, base number default 1) return pljson_element as
path pljson_list;
ret pljson_element;
o pljson; l pljson_list;
begin
path := parsePath(v_path, base);
ret := obj;
if (path.count = 0) then return ret; end if;
for i in 1 .. path.count loop
if (path.get(i).is_string()) then
--string fetch only on json
------o := pljson(ret);
------ret := o.get(path.get(i).get_string());
/* E.I.Sarmas (github.com/dsnz) 2020-04-18 use inheritance and avoid treat() */
ret := ret.get(path.get(i).get_string());
--experimental, ignore
--ret := get_piece(o, path.get(i).get_string());
else
--number fetch on json and json_list
if (ret.is_array()) then
------l := pljson_list(ret);
------ret := l.get(path.get(i).get_number());
/* E.I.Sarmas (github.com/dsnz) 2020-04-18 use inheritance and avoid treat() */
ret := ret.get(path.get(i).get_number());
--experimental, ignore
--ret := get_piece(l, path.get(i).get_number());
else
------o := pljson(ret);
------l := o.get_values();
------ret := l.get(path.get(i).get_number());
/* E.I.Sarmas (github.com/dsnz) 2020-04-18 use inheritance and avoid treat() */
ret := ret.get(path.get(i).get_number());
--experimental, ignore
--ret := get_piece(l, path.get(i).get_number());
end if;
end if;
end loop;
return ret;
exception
when scanner_exception then raise;
when parser_exception then raise;
when jext_exception then raise;
when others then return null;
end get_json_element_original;
function get_json_element(obj pljson, v_path varchar2, base number default 1) return pljson_element as
path pljson_list;
begin
path := parsePath(v_path, base);
return get_json_element(obj, path);
end get_json_element;
function get_string(obj pljson, path varchar2, base number default 1) return varchar2 as
temp pljson_element;
begin
temp := get_json_element(obj, path, base);
if (temp is null or not temp.is_string()) then
return null;
else
return temp.get_string();
end if;
end;
function get_number(obj pljson, path varchar2, base number default 1) return number as
temp pljson_element;
begin
temp := get_json_element(obj, path, base);
if (temp is null or not temp.is_number()) then
return null;
else
return temp.get_number();
end if;
end;
/* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */
function get_double(obj pljson, path varchar2, base number default 1) return binary_double as
temp pljson_element;
begin
temp := get_json_element(obj, path, base);
if (temp is null or not temp.is_number()) then
return null;
else
return temp.get_double();
end if;
end;
function get_json(obj pljson, path varchar2, base number default 1) return pljson as
temp pljson_element;
begin
temp := get_json_element(obj, path, base);
if (temp is null or not temp.is_object()) then
return null;
else
return treat(temp as pljson);
end if;
end;
function get_json_list(obj pljson, path varchar2, base number default 1) return pljson_list as
temp pljson_element;
begin
temp := get_json_element(obj, path, base);
if (temp is null or not temp.is_array()) then
return null;
else
return treat(temp as pljson_list);
end if;
end;
function get_bool(obj pljson, path varchar2, base number default 1) return boolean as
temp pljson_element;
begin
temp := get_json_element(obj, path, base);
if (temp is null or not temp.is_bool()) then
return null;
else
return temp.get_bool();
end if;
end;
function get_date(obj pljson, path varchar2, base number default 1) return date as
temp pljson_element;
begin
temp := get_json_element(obj, path, base);
if (temp is null or not is_date(temp)) then
return null;
else
return pljson_ext.to_date(temp);
end if;
end;
/* JSON pre-parsed path putter internal function */
procedure put_internal_preparsed(obj in out nocopy pljson, path pljson_list, elem pljson_element) as
path_segments pljson_path := pljson_path();
dummy boolean;
begin
if (path.count = 0) then raise_application_error(-20110, 'PLJSON_EXT put error: cannot put with empty string.'); end if;
for i in 1 .. path.count loop
path_segments.extend;
if (path.get(i).is_number()) then
path_segments(path_segments.count) := pljson_path_segment(path.get(i).get_number(), null);
else
path_segments(path_segments.count) := pljson_path_segment(null, path.get(i).get_string());
end if;
end loop;
dummy := obj.put_internal_path(path_segments, elem, 1);
end;
/* JSON Path putter internal function */
--saved original code, in case of future bug troubleshooting
procedure put_internal_original(obj in out nocopy pljson, v_path varchar2, elem pljson_element, base number) as
val pljson_element := elem;
path pljson_list;
backreference pljson_list := pljson_list();
keyval pljson_element; keynum number; keystring varchar2(4000);
temp pljson_element := obj;
obj_temp pljson;
list_temp pljson_list;
inserter pljson_element;
begin
path := pljson_ext.parsePath(v_path, base);
if (path.count = 0) then raise_application_error(-20110, 'PLJSON_EXT put error: cannot put with empty string.'); end if;
--build backreference
for i in 1 .. path.count loop
--backreference.print(false);
keyval := path.get(i);
if (keyval.is_number()) then
--number index
keynum := keyval.get_number();
if ((not temp.is_object()) and (not temp.is_array())) then
if (val is null) then return; end if;
backreference.remove_last;
temp := pljson_list();
backreference.append(temp);
end if;
if (temp.is_object()) then
obj_temp := pljson(temp);
if (obj_temp.count < keynum) then
if (val is null) then return; end if;
raise_application_error(-20110, 'PLJSON_EXT put error: access object with too few members.');
end if;
temp := obj_temp.get(keynum);
else
list_temp := pljson_list(temp);
if (list_temp.count < keynum) then
if (val is null) then return; end if;
--raise error or quit if val is null
for i in list_temp.count+1 .. keynum loop
list_temp.append(pljson_null());
end loop;
backreference.remove_last;
backreference.append(list_temp);
end if;
temp := list_temp.get(keynum);
end if;
else
--string index
keystring := keyval.get_string();
if (not temp.is_object()) then
--backreference.print;
if (val is null) then return; end if;
backreference.remove_last;
temp := pljson();
backreference.append(temp);
--raise_application_error(-20110, 'PLJSON_EXT put error: trying to access a non object with a string.');
end if;
obj_temp := pljson(temp);
temp := obj_temp.get(keystring);
end if;
if (temp is null) then
if (val is null) then return; end if;
--what to expect?
keyval := path.get(i+1);
if (keyval is not null and keyval.is_number()) then
temp := pljson_list();
else
temp := pljson();
end if;
end if;
backreference.append(temp);
end loop;
-- backreference.print(false);
-- path.print(false);
--use backreference and path together
inserter := val;
for i in reverse 1 .. backreference.count loop
-- inserter.print(false);
if ( i = 1 ) then
keyval := path.get(1);
if (keyval.is_string()) then
keystring := keyval.get_string();
else
keynum := keyval.get_number();
declare
t1 pljson_element := obj.get(keynum);
begin
keystring := t1.mapname;
end;
end if;
if (inserter is null) then obj.remove(keystring); else obj.put(keystring, inserter); end if;
else
temp := backreference.get(i-1);
if (temp.is_object()) then
keyval := path.get(i);
obj_temp := pljson(temp);
if (keyval.is_string()) then
keystring := keyval.get_string();
else
keynum := keyval.get_number();
declare
t1 pljson_element := obj_temp.get(keynum);
begin
keystring := t1.mapname;
end;
end if;
if (inserter is null) then
obj_temp.remove(keystring);
if (obj_temp.count > 0) then inserter := obj_temp; end if;
else
obj_temp.put(keystring, inserter);
inserter := obj_temp;
end if;
else
--array only number
keynum := path.get(i).get_number();
list_temp := pljson_list(temp);
list_temp.remove(keynum);
if (not inserter is null) then
list_temp.append(inserter, keynum);
inserter := list_temp;
else
if (list_temp.count > 0) then inserter := list_temp; end if;
end if;
end if;
end if;
end loop;
end put_internal_original;
procedure put_internal(obj in out nocopy pljson, v_path varchar2, elem pljson_element, base number) as
path pljson_list;
begin
path := pljson_ext.parsePath(v_path, base);
put_internal_preparsed(obj, path, elem);
end put_internal;
/* JSON pre-parsed path putters */
procedure put(obj in out nocopy pljson, path pljson_list, elem varchar2) as
begin
if elem is null then
put_internal_preparsed(obj, path, pljson_null());
else
put_internal_preparsed(obj, path, pljson_string(elem));
end if;
end;
procedure put(obj in out nocopy pljson, path pljson_list, elem number) as
begin
if elem is null then
put_internal_preparsed(obj, path, pljson_null());
else
put_internal_preparsed(obj, path, pljson_number(elem));
end if;
end;
procedure put(obj in out nocopy pljson, path pljson_list, elem binary_double) as
begin
if elem is null then
put_internal_preparsed(obj, path, pljson_null());
else
put_internal_preparsed(obj, path, pljson_number(elem));
end if;
end;
procedure put(obj in out nocopy pljson, path pljson_list, elem pljson) as
begin
if elem is null then
put_internal_preparsed(obj, path, pljson_null());
else
put_internal_preparsed(obj, path, elem);
end if;
end;
procedure put(obj in out nocopy pljson, path pljson_list, elem pljson_list) as
begin
if elem is null then
put_internal_preparsed(obj, path, pljson_null());
else
put_internal_preparsed(obj, path, elem);
end if;
end;
procedure put(obj in out nocopy pljson, path pljson_list, elem boolean) as
begin
if elem is null then
put_internal_preparsed(obj, path, pljson_null());
else
put_internal_preparsed(obj, path, pljson_bool(elem));
end if;
end;
procedure put(obj in out nocopy pljson, path pljson_list, elem pljson_element) as
begin
if elem is null then
put_internal_preparsed(obj, path, pljson_null());
else
put_internal_preparsed(obj, path, elem);
end if;
end;
procedure put(obj in out nocopy pljson, path pljson_list, elem date) as
begin
if elem is null then
put_internal_preparsed(obj, path, pljson_null());
else
put_internal_preparsed(obj, path, pljson_ext.to_json_string(elem));
end if;
end;
/* JSON Path putters */
procedure put(obj in out nocopy pljson, path varchar2, elem varchar2, base number default 1) as
begin
if elem is null then
put_internal(obj, path, pljson_null(), base);
else
put_internal(obj, path, pljson_string(elem), base);
end if;
end;
procedure put(obj in out nocopy pljson, path varchar2, elem number, base number default 1) as
begin
if elem is null then
put_internal(obj, path, pljson_null(), base);
else
put_internal(obj, path, pljson_number(elem), base);
end if;
end;
/* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */
procedure put(obj in out nocopy pljson, path varchar2, elem binary_double, base number default 1) as
begin
if elem is null then
put_internal(obj, path, pljson_null(), base);
else
put_internal(obj, path, pljson_number(elem), base);
end if;
end;
procedure put(obj in out nocopy pljson, path varchar2, elem pljson, base number default 1) as
begin
if elem is null then
put_internal(obj, path, pljson_null(), base);
else
put_internal(obj, path, elem, base);
end if;
end;
procedure put(obj in out nocopy pljson, path varchar2, elem pljson_list, base number default 1) as
begin
if elem is null then
put_internal(obj, path, pljson_null(), base);
else
put_internal(obj, path, elem, base);
end if;
end;
procedure put(obj in out nocopy pljson, path varchar2, elem boolean, base number default 1) as
begin
if elem is null then
put_internal(obj, path, pljson_null(), base);
else
put_internal(obj, path, pljson_bool(elem), base);
end if;
end;
procedure put(obj in out nocopy pljson, path varchar2, elem pljson_element, base number default 1) as
begin
if elem is null then
put_internal(obj, path, pljson_null(), base);
else
put_internal(obj, path, elem, base);
end if;
end;
procedure put(obj in out nocopy pljson, path varchar2, elem date, base number default 1) as
begin
if elem is null then
put_internal(obj, path, pljson_null(), base);
else
put_internal(obj, path, pljson_ext.to_json_string(elem), base);
end if;
end;
procedure remove(obj in out nocopy pljson, path pljson_list) as
begin
pljson_ext.put_internal_preparsed(obj, path, null);
end remove;
procedure remove(obj in out nocopy pljson, path varchar2, base number default 1) as
begin
pljson_ext.put_internal(obj, path, null, base);
--if (json_ext.get_json_element(obj, path) is not null) then
--end if;
end remove;
--Pretty print with JSON Path
function pp(obj pljson, v_path varchar2) return varchar2 as
json_part pljson_element;
begin
json_part := pljson_ext.get_json_element(obj, v_path);
if (json_part is null) then
return '';
else
return pljson_printer.pretty_print_any(json_part); --escapes a possible internal string
end if;
end pp;
procedure pp(obj pljson, v_path varchar2) as --using dbms_output.put_line
begin
dbms_output.put_line(pp(obj, v_path));
end pp;
-- spaces = false!
procedure pp_htp(obj pljson, v_path varchar2) as --using htp.print
json_part pljson_element;
begin
json_part := pljson_ext.get_json_element(obj, v_path);
if (json_part is null) then
htp.print;
else
htp.print(pljson_printer.pretty_print_any(json_part, false));
end if;
end pp_htp;
function base64(binarydata blob) return pljson_list as
obj pljson_list := pljson_list();
c clob;
v_clob_offset number := 1;
v_lang_context number := dbms_lob.DEFAULT_LANG_CTX;
v_amount number;
begin
--dbms_lob.createtemporary(c, false, dbms_lob.call);
c := encodeBase64Blob2Clob(binarydata);
v_amount := dbms_lob.getlength(c);
v_clob_offset := 1;
--dbms_output.put_line('v_amount: '||v_amount);
while (v_clob_offset < v_amount) loop
--dbms_output.put_line(v_offset);
--temp := ;
--dbms_output.put_line('size: '||length(temp));
obj.append(dbms_lob.substr(c, 4000, v_clob_offset));
v_clob_offset := v_clob_offset + 4000;
end loop;
dbms_lob.freetemporary(c);
--dbms_output.put_line(obj.count);
--dbms_output.put_line(obj.get_last().to_char);
return obj;
end base64;
function base64(l pljson_list) return blob as
c clob;
b_ret blob;
v_lang_context number := dbms_lob.DEFAULT_LANG_CTX;
-- v_amount number;
begin
dbms_lob.createtemporary(c, false, dbms_lob.call);
for i in 1 .. l.count loop
dbms_lob.append(c, l.get(i).get_string());
end loop;
-- v_amount := dbms_lob.getlength(c);
-- dbms_output.put_line('L C'||v_amount);
b_ret := decodeBase64Clob2Blob(c);
dbms_lob.freetemporary(c);
return b_ret;
end base64;
function encode(binarydata blob) return pljson_string as
obj pljson_string;
c clob;
v_lang_context number := dbms_lob.DEFAULT_LANG_CTX;
begin
dbms_lob.createtemporary(c, false, dbms_lob.call);
c := encodeBase64Blob2Clob(binarydata);
obj := pljson_string(c);
--dbms_output.put_line(obj.count);
--dbms_output.put_line(obj.get_last().to_char);
/* dbms_lob.freetemporary(c); */
return obj;
end encode;
function decode(v pljson_string) return blob as
c clob;
b_ret blob;
v_lang_context number := dbms_lob.DEFAULT_LANG_CTX;
-- v_amount number;
begin
/*
dbms_lob.createtemporary(c, false, dbms_lob.call);
v.get_string(c);
*/
c := v.get_clob();
-- v_amount := dbms_lob.getlength(c);
-- dbms_output.put_line('L C'||v_amount);
b_ret := decodeBase64Clob2Blob(c);
/* dbms_lob.freetemporary(c); */
return b_ret;
end decode;
procedure blob2clob(b blob, c out clob, charset varchar2 default 'UTF8') as
v_dest_offset number := 1;
v_src_offset number := 1;
v_lang_context number := dbms_lob.DEFAULT_LANG_CTX;
v_warning number := dbms_lob.NO_WARNING;
begin
dbms_lob.createtemporary(c, false, dbms_lob.call);
dbms_lob.converttoclob(
dest_lob => c,
src_blob => b,
amount => dbms_lob.LOBMAXSIZE,
dest_offset => v_dest_offset,
src_offset => v_src_offset,
blob_csid => nls_charset_id(charset),
lang_context => v_lang_context,
warning => v_warning);
end;
end pljson_ext;
/
show err
-- --- pljson_element.type.impl (body) ---
create or replace type body pljson_element as
constructor function pljson_element return self as result as
begin
raise_application_error(-20000, 'pljson_element is not instantiable');
end;
/* all the is_ methods can
test against typeval or
return false and be overriden in children
*/
member function is_object return boolean as
begin
return false;
end;
member function is_array return boolean as
begin
return false;
end;
member function is_string return boolean as
begin
return false;
end;
member function is_number return boolean as
begin
return false;
end;
member function is_bool return boolean as
begin
return false;
end;
member function is_null return boolean as
begin
return false;
end;
member function get_type return varchar2 as
begin
case self.typeval
when 1 then return 'object';
when 2 then return 'array';
when 3 then return 'string';
when 4 then return 'number';
when 5 then return 'bool';
when 6 then return 'null';
end case;
return 'unknown type';
end;
member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2 as
begin
raise_application_error(-20002, 'value_of() method should be overriden');
end;
/*
member methods to remove need for treat()
*/
member function get_string(max_byte_size number default null, max_char_size number default null) return varchar2 as
begin
raise_application_error(-20003, 'get_string() method is not supported by object of type:' || get_type());
end;
member function get_clob return clob as
begin
raise_application_error(-20004, 'get_clob() method is not supported by object of type:' || get_type());
end;
member function get_number return number as
begin
raise_application_error(-20005, 'get_number() method is not supported by object of type:' || get_type());
end;
member function get_double return binary_double as
begin
raise_application_error(-20006, 'get_double() method is not supported by object of type:' || get_type());
end;
member function is_number_repr_number return boolean as
begin
raise_application_error(-20008, 'is_number_repr_number() method is not supported by object of type:' || get_type());
end;
member function is_number_repr_double return boolean as
begin
raise_application_error(-20009, 'is_number_repr_double() method is not supported by object of type:' || get_type());
end;
member function get_bool return boolean as
begin
raise_application_error(-20007, 'get_bool() method is not supported by object of type:' || get_type());
end;
member function count return number as
begin
raise_application_error(-20012, 'count() method is not supported by object of type:' || get_type());
end;
member function get(pair_name varchar2) return pljson_element as
begin
raise_application_error(-20020, 'get(name) method is not supported by object of type:' || get_type());
end;
member function get(position pls_integer) return pljson_element as
begin
raise_application_error(-20021, 'get(position) method is not supported by object of type:' || get_type());
end;
member function path(json_path varchar2, base number default 1) return pljson_element as
begin
raise_application_error(-20010, 'path() method is not supported by object of type:' || get_type());
end;
/* output methods */
member function to_char(spaces boolean default true, chars_per_line number default 0) return varchar2 as
begin
if (spaces is null) then
return pljson_printer.pretty_print_any(self, line_length => chars_per_line);
else
return pljson_printer.pretty_print_any(self, spaces, line_length => chars_per_line);
end if;
end;
member procedure to_clob(self in pljson_element, buf in out nocopy clob, spaces boolean default false, chars_per_line number default 0, erase_clob boolean default true) as
begin
if (spaces is null) then
pljson_printer.pretty_print_any(self, false, buf, line_length => chars_per_line, erase_clob => erase_clob);
else
pljson_printer.pretty_print_any(self, spaces, buf, line_length => chars_per_line, erase_clob => erase_clob);
end if;
end;
member procedure print(self in pljson_element, spaces boolean default true, chars_per_line number default 8192, jsonp varchar2 default null) as --32512 is the real maximum in sqldeveloper
my_clob clob;
begin
dbms_lob.createtemporary(my_clob, true);
pljson_printer.pretty_print_any(self, spaces, my_clob, case when (chars_per_line>32512) then 32512 else chars_per_line end);
pljson_printer.dbms_output_clob(my_clob, pljson_printer.newline_char, jsonp);
dbms_lob.freetemporary(my_clob);
end;
member procedure htp(self in pljson_element, spaces boolean default false, chars_per_line number default 0, jsonp varchar2 default null) as
my_clob clob;
begin
dbms_lob.createtemporary(my_clob, true);
pljson_printer.pretty_print_any(self, spaces, my_clob, chars_per_line);
pljson_printer.htp_output_clob(my_clob, jsonp);
dbms_lob.freetemporary(my_clob);
end;
/* private method for internal use, not part of the API, contributed by @asfernandes */
member procedure get_internal_path(self in pljson_element, path pljson_path, path_position pls_integer, ret out nocopy pljson_element) as
begin
raise_application_error(-20010, 'path() method is not supported by object of type:' || get_type());
end;
/* private method for internal use, not part of the API, contributed by @asfernandes */
member function put_internal_path(self in out nocopy pljson_element, path pljson_path, elem pljson_element, path_position pls_integer) return boolean as
begin
return false;
end;
end;
/
show err
-- --- pljson_list.type.impl (body) ---
create or replace type body pljson_list as
/* constructors */
constructor function pljson_list return self as result as
begin
self.list_data := pljson_element_array();
self.typeval := 2;
--self.object_id := pljson_object_cache.next_id;
return;
end;
constructor function pljson_list(str varchar2) return self as result as
begin
self := pljson_parser.parse_list(str);
--self.typeval := 2;
return;
end;
constructor function pljson_list(str clob) return self as result as
begin
self := pljson_parser.parse_list(str);
--self.typeval := 2;
return;
end;
constructor function pljson_list(str blob, charset varchar2 default 'UTF8') return self as result as
c_str clob;
begin
pljson_ext.blob2clob(str, c_str, charset);
self := pljson_parser.parse_list(c_str);
--self.typeval := 2;
return;
end;
constructor function pljson_list(str_array pljson_varray) return self as result as
begin
self.list_data := pljson_element_array();
self.typeval := 2;
for i in str_array.FIRST .. str_array.LAST loop
append(str_array(i));
end loop;
--self.object_id := pljson_object_cache.next_id;
return;
end;
constructor function pljson_list(num_array pljson_narray) return self as result as
begin
self.list_data := pljson_element_array();
self.typeval := 2;
for i in num_array.FIRST .. num_array.LAST loop
append(num_array(i));
end loop;
--self.object_id := pljson_object_cache.next_id;
return;
end;
constructor function pljson_list(elem pljson_element) return self as result as
begin
self := treat(elem as pljson_list);
--self.typeval := 2;
return;
end;
constructor function pljson_list(elem_array pljson_element_array) return self as result as
begin
self.list_data := elem_array;
self.typeval := 2;
return;
end;
overriding member function is_array return boolean as
begin
return true;
end;
overriding member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2 as
begin
return 'json array';
end;
/* list management */
member procedure append(self in out nocopy pljson_list, elem pljson_element, position pls_integer default null) as
indx pls_integer;
--insert_value pljson_element;
begin
/*
insert_value := elem;
if insert_value is null then
insert_value := pljson_null();
end if;
*/
if (position is null or position > self.count) then --end of list
indx := self.count + 1;
self.list_data.extend(1);
elsif (position < 1) then --new first
indx := self.count;
self.list_data.extend(1);
for x in reverse 1 .. indx loop
self.list_data(x+1) := self.list_data(x);
end loop;
indx := 1;
--self.list_data(1) := insert_value;
else
indx := self.count;
self.list_data.extend(1);
for x in reverse position .. indx loop
self.list_data(x+1) := self.list_data(x);
end loop;
indx := position;
--self.list_data(position) := insert_value;
end if;
if elem is not null then
self.list_data(indx) := elem;
else
self.list_data(indx) := pljson_null();
end if;
end;
member procedure append(self in out nocopy pljson_list, elem varchar2, position pls_integer default null) as
begin
if (elem is null and pljson_parser.empty_string_as_null) then
append(pljson_null(), position);
else
append(pljson_string(elem), position);
end if;
end;
member procedure append(self in out nocopy pljson_list, elem clob, position pls_integer default null) as
begin
if (elem is null) then
append(pljson_null(), position);
else
append(pljson_string(elem), position);
end if;
end;
member procedure append(self in out nocopy pljson_list, elem number, position pls_integer default null) as
begin
if (elem is null) then
append(pljson_null(), position);
else
append(pljson_number(elem), position);
end if;
end;
/* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */
member procedure append(self in out nocopy pljson_list, elem binary_double, position pls_integer default null) as
begin
if (elem is null) then
append(pljson_null(), position);
else
append(pljson_number(elem), position);
end if;
end;
member procedure append(self in out nocopy pljson_list, elem boolean, position pls_integer default null) as
begin
if (elem is null) then
append(pljson_null(), position);
else
append(pljson_bool(elem), position);
end if;
end;
member procedure append(self in out nocopy pljson_list, elem pljson_list, position pls_integer default null) as
begin
if (elem is null) then
append(pljson_null(), position);
else
append(treat(elem as pljson_element), position);
end if;
end;
member procedure replace(self in out nocopy pljson_list, position pls_integer, elem pljson_element) as
insert_value pljson_element;
indx number;
begin
insert_value := elem;
if insert_value is null then
insert_value := pljson_null();
end if;
if (position > self.count) then --end of list
indx := self.count + 1;
self.list_data.extend(1);
self.list_data(indx) := insert_value;
elsif (position < 1) then --maybe an error message here
null;
else
self.list_data(position) := insert_value;
end if;
end;
member procedure replace(self in out nocopy pljson_list, position pls_integer, elem varchar2) as
begin
if (elem is null and pljson_parser.empty_string_as_null) then
replace(position, pljson_null());
else
replace(position, pljson_string(elem));
end if;
end;
member procedure replace(self in out nocopy pljson_list, position pls_integer, elem clob) as
begin
if (elem is null) then
replace(position, pljson_null());
else
replace(position, pljson_string(elem));
end if;
end;
member procedure replace(self in out nocopy pljson_list, position pls_integer, elem number) as
begin
if (elem is null) then
replace(position, pljson_null());
else
replace(position, pljson_number(elem));
end if;
end;
/* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */
member procedure replace(self in out nocopy pljson_list, position pls_integer, elem binary_double) as
begin
if (elem is null) then
replace(position, pljson_null());
else
replace(position, pljson_number(elem));
end if;
end;
member procedure replace(self in out nocopy pljson_list, position pls_integer, elem boolean) as
begin
if (elem is null) then
replace(position, pljson_null());
else
replace(position, pljson_bool(elem));
end if;
end;
member procedure replace(self in out nocopy pljson_list, position pls_integer, elem pljson_list) as
begin
if (elem is null) then
replace(position, pljson_null());
else
replace(position, treat(elem as pljson_element));
end if;
end;
member procedure remove(self in out nocopy pljson_list, position pls_integer) as
begin
if (position is null or position < 1 or position > self.count) then return; end if;
for x in (position+1) .. self.count loop
self.list_data(x-1) := self.list_data(x);
end loop;
self.list_data.trim(1);
end;
member procedure remove_first(self in out nocopy pljson_list) as
begin
for x in 2 .. self.count loop
self.list_data(x-1) := self.list_data(x);
end loop;
if (self.count > 0) then
self.list_data.trim(1);
end if;
end;
member procedure remove_last(self in out nocopy pljson_list) as
begin
if (self.count > 0) then
self.list_data.trim(1);
end if;
end;
overriding member function count return number as
begin
return self.list_data.count;
end;
overriding member function get(position pls_integer) return pljson_element as
begin
if (self.count >= position and position > 0) then
return self.list_data(position);
end if;
return null; -- do not throw error, just return null
end;
member function get_string(position pls_integer) return varchar2 as
elem pljson_element := get(position);
begin
if elem is not null and elem is of (pljson_string) then
return elem.get_string();
end if;
return null;
end;
member function get_clob(position pls_integer) return clob as
elem pljson_element := get(position);
begin
if elem is not null and elem is of (pljson_string) then
return elem.get_clob();
end if;
return null;
end;
member function get_number(position pls_integer) return number as
elem pljson_element := get(position);
begin
if elem is not null and elem is of (pljson_number) then
return elem.get_number();
end if;
return null;
end;
member function get_double(position pls_integer) return binary_double as
elem pljson_element := get(position);
begin
if elem is not null and elem is of (pljson_number) then
return elem.get_double();
end if;
return null;
end;
member function get_bool(position pls_integer) return boolean as
elem pljson_element := get(position);
begin
if elem is not null and elem is of (pljson_bool) then
return elem.get_bool();
end if;
return null;
end;
member function get_pljson_list(position pls_integer) return pljson_list as
elem pljson_element := get(position);
begin
if elem is not null and elem is of (pljson_list) then
return treat(elem as pljson_list);
end if;
return null;
end;
member function head return pljson_element as
begin
if (self.count > 0) then
return self.list_data(self.list_data.first);
end if;
return null; -- do not throw error, just return null
end;
member function last return pljson_element as
begin
if (self.count > 0) then
return self.list_data(self.list_data.last);
end if;
return null; -- do not throw error, just return null
end;
member function tail return pljson_list as
t pljson_list;
begin
if (self.count > 0) then
t := self; --pljson_list(self);
t.remove(1);
return t;
else
return pljson_list();
end if;
end;
/* json path */
overriding member function path(json_path varchar2, base number default 1) return pljson_element as
cp pljson_list := self;
begin
return pljson_ext.get_json_element(pljson(cp), json_path, base);
end path;
/* json path_put */
member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem pljson_element, base number default 1) as
objlist pljson;
jp pljson_list := pljson_ext.parsePath(json_path, base);
begin
while (jp.head().get_number() > self.count) loop
self.append(pljson_null());
end loop;
objlist := pljson(self);
pljson_ext.put(objlist, json_path, elem, base);
self := objlist.get_values;
end path_put;
member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem varchar2, base number default 1) as
objlist pljson;
jp pljson_list := pljson_ext.parsePath(json_path, base);
begin
while (jp.head().get_number() > self.count) loop
self.append(pljson_null());
end loop;
objlist := pljson(self);
if (elem is null and pljson_parser.empty_string_as_null) then
pljson_ext.put(objlist, json_path, pljson_null(), base);
else
pljson_ext.put(objlist, json_path, elem, base);
end if;
self := objlist.get_values;
end path_put;
member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem clob, base number default 1) as
objlist pljson;
jp pljson_list := pljson_ext.parsePath(json_path, base);
begin
while (jp.head().get_number() > self.count) loop
self.append(pljson_null());
end loop;
objlist := pljson(self);
if (elem is null) then
pljson_ext.put(objlist, json_path, pljson_null(), base);
else
pljson_ext.put(objlist, json_path, elem, base);
end if;
self := objlist.get_values;
end path_put;
member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem number, base number default 1) as
objlist pljson;
jp pljson_list := pljson_ext.parsePath(json_path, base);
begin
while (jp.head().get_number() > self.count) loop
self.append(pljson_null());
end loop;
objlist := pljson(self);
if (elem is null) then
pljson_ext.put(objlist, json_path, pljson_null(), base);
else
pljson_ext.put(objlist, json_path, elem, base);
end if;
self := objlist.get_values;
end path_put;
/* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */
member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem binary_double, base number default 1) as
objlist pljson;
jp pljson_list := pljson_ext.parsePath(json_path, base);
begin
while (jp.head().get_number() > self.count) loop
self.append(pljson_null());
end loop;
objlist := pljson(self);
if (elem is null) then
pljson_ext.put(objlist, json_path, pljson_null(), base);
else
pljson_ext.put(objlist, json_path, elem, base);
end if;
self := objlist.get_values;
end path_put;
member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem boolean, base number default 1) as
objlist pljson;
jp pljson_list := pljson_ext.parsePath(json_path, base);
begin
while (jp.head().get_number() > self.count) loop
self.append(pljson_null());
end loop;
objlist := pljson(self);
if (elem is null) then
pljson_ext.put(objlist, json_path, pljson_null(), base);
else
pljson_ext.put(objlist, json_path, elem, base);
end if;
self := objlist.get_values;
end path_put;
member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem pljson_list, base number default 1) as
objlist pljson;
jp pljson_list := pljson_ext.parsePath(json_path, base);
begin
while (jp.head().get_number() > self.count) loop
self.append(pljson_null());
end loop;
objlist := pljson(self);
if (elem is null) then
pljson_ext.put(objlist, json_path, pljson_null(), base);
else
pljson_ext.put(objlist, json_path, elem, base);
end if;
self := objlist.get_values;
end path_put;
/* json path_remove */
member procedure path_remove(self in out nocopy pljson_list, json_path varchar2, base number default 1) as
objlist pljson := pljson(self);
begin
pljson_ext.remove(objlist, json_path, base);
self := objlist.get_values;
end path_remove;
/* private method for internal use, not part of the API, contributed by @asfernandes */
overriding member procedure get_internal_path(self in pljson_list, path pljson_path, path_position pls_integer, ret out nocopy pljson_element) as
indx pls_integer := path(path_position).indx;
begin
if (indx <= self.list_data.count) then
if (path_position < path.count) then
self.list_data(indx).get_internal_path(path, path_position + 1, ret);
else
ret := self.list_data(indx);
end if;
end if;
end;
/* private method for internal use, not part of the API, contributed by @asfernandes */
overriding member function put_internal_path(self in out nocopy pljson_list, path pljson_path, elem pljson_element, path_position pls_integer) return boolean as
indx pls_integer := path(path_position).indx;
begin
indx := path(path_position).indx;
if (indx > self.list_data.count) then
if (elem is null) then
return false;
end if;
self.list_data.extend;
self.list_data(self.list_data.count) := pljson_null();
if (indx > self.list_data.count) then
self.list_data.extend(indx - self.list_data.count, self.list_data.count);
end if;
end if;
if (path_position < path.count) then
if (path(path_position + 1).indx is null) then
if (not self.list_data(indx).is_object()) then
if (elem is not null) then
self.list_data(indx) := pljson();
else
return false;
end if;
end if;
else
if (not self.list_data(indx).is_object() and not self.list_data(indx).is_array()) then
if (elem is not null) then
self.list_data(indx) := pljson_list();
else
return false;
end if;
end if;
end if;
if (self.list_data(indx).put_internal_path(path, elem, path_position + 1)) then
self.remove(indx);
return self.list_data.count = 0;
end if;
else
if (elem is not null) then
self.list_data(indx) := elem;
else
self.remove(indx);
return self.list_data.count = 0;
end if;
end if;
return false;
end;
end;
/
show err
-- --- pljson.type.impl (body) ---
create or replace type body pljson as
/* constructors */
constructor function pljson return self as result as
begin
self.json_data := pljson_element_array();
self.typeval := 1;
self.check_for_duplicate := 1;
--self.object_id := pljson_object_cache.next_id;
return;
end;
constructor function pljson(str varchar2) return self as result as
begin
self := pljson_parser.parser(str);
--self.typeval := 1;
self.check_for_duplicate := 1;
return;
end;
constructor function pljson(str in clob) return self as result as
begin
self := pljson_parser.parser(str);
--self.typeval := 1;
self.check_for_duplicate := 1;
return;
end;
constructor function pljson(str in blob, charset varchar2 default 'UTF8') return self as result as
c_str clob;
begin
pljson_ext.blob2clob(str, c_str, charset);
self := pljson_parser.parser(c_str);
--self.typeval := 1;
self.check_for_duplicate := 1;
return;
end;
constructor function pljson(str_array pljson_varray) return self as result as
new_pair boolean := True;
pair_name varchar2(32767);
pair_value varchar2(32767);
begin
self.typeval := 1;
self.check_for_duplicate := 1;
self.json_data := pljson_element_array();
for i in str_array.FIRST .. str_array.LAST loop
if new_pair then
pair_name := str_array(i);
new_pair := False;
else
pair_value := str_array(i);
put(pair_name, pair_value);
new_pair := True;
end if;
end loop;
--self.object_id := pljson_object_cache.next_id;
return;
end;
constructor function pljson(elem pljson_element) return self as result as
begin
self := treat(elem as pljson);
--self.typeval := 1;
self.check_for_duplicate := 1;
return;
end;
constructor function pljson(l pljson_list) return self as result as
begin
self.typeval := 1;
self.check_for_duplicate := 1;
self.json_data := pljson_element_array();
for i in 1 .. l.list_data.count loop
self.json_data.extend(1);
self.json_data(i) := l.list_data(i);
if (l.list_data(i).mapname is null or l.list_data(i).mapname like 'row%') then
self.json_data(i).mapname := 'row'||i;
end if;
self.json_data(i).mapindx := i;
end loop;
--self.object_id := pljson_object_cache.next_id;
return;
end;
overriding member function is_object return boolean as
begin
return true;
end;
overriding member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2 as
begin
return 'json object';
end;
/* member management */
member procedure remove(self in out nocopy pljson, pair_name varchar2) as
temp pljson_element;
indx pls_integer;
begin
temp := get(pair_name);
if (temp is null) then return; end if;
indx := json_data.next(temp.mapindx);
loop
exit when indx is null;
json_data(indx).mapindx := indx - 1;
json_data(indx-1) := json_data(indx);
indx := json_data.next(indx);
end loop;
json_data.trim(1);
end;
member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value pljson_element, position pls_integer default null) as
insert_value pljson_element;
indx pls_integer; x number;
temp pljson_element;
begin
--dbms_output.put_line('name: ' || pair_name);
--if (pair_name is null) then
-- raise_application_error(-20102, 'JSON put-method type error: name cannot be null');
--end if;
insert_value := pair_value;
if insert_value is null then
insert_value := pljson_null();
end if;
insert_value.mapname := pair_name;
if (self.check_for_duplicate = 1) then temp := get(pair_name); else temp := null; end if;
if (temp is not null) then
insert_value.mapindx := temp.mapindx;
json_data(temp.mapindx) := insert_value;
return;
elsif (position is null or position > self.count) then
--insert at the end of the list
--dbms_output.put_line('insert end');
json_data.extend(1);
/* changed to common style of updating mapindx; fix bug in assignment order */
insert_value.mapindx := json_data.count;
json_data(json_data.count) := insert_value;
--dbms_output.put_line('mapindx: ' || insert_value.mapindx);
--dbms_output.put_line('mapname: ' || insert_value.mapname);
elsif (position < 2) then
--insert at the start of the list
indx := json_data.last;
json_data.extend;
loop
exit when indx is null;
temp := json_data(indx);
temp.mapindx := indx+1;
json_data(temp.mapindx) := temp;
indx := json_data.prior(indx);
end loop;
/* changed to common style of updating mapindx; fix bug in assignment order */
insert_value.mapindx := 1;
json_data(1) := insert_value;
else
--insert somewhere in the list
indx := json_data.last;
--dbms_output.put_line('indx: ' || indx);
json_data.extend;
loop
--dbms_output.put_line('indx: ' || indx);
temp := json_data(indx);
temp.mapindx := indx + 1;
json_data(temp.mapindx) := temp;
exit when indx = position;
indx := json_data.prior(indx);
end loop;
/* changed to common style of updating mapindx; fix bug in assignment order */
insert_value.mapindx := position;
json_data(position) := insert_value;
end if;
end;
member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value varchar2, position pls_integer default null) as
begin
if (pair_value is null and pljson_parser.empty_string_as_null) then
put(pair_name, pljson_null(), position);
else
put(pair_name, pljson_string(pair_value), position);
end if;
end;
member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value clob, position pls_integer default null) as
begin
if (pair_value is null) then
put(pair_name, pljson_null(), position);
else
put(pair_name, pljson_string(pair_value), position);
end if;
end;
member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value number, position pls_integer default null) as
begin
if (pair_value is null) then
put(pair_name, pljson_null(), position);
else
put(pair_name, pljson_number(pair_value), position);
end if;
end;
/* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */
member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value binary_double, position pls_integer default null) as
begin
if (pair_value is null) then
put(pair_name, pljson_null(), position);
else
put(pair_name, pljson_number(pair_value), position);
end if;
end;
member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value boolean, position pls_integer default null) as
begin
if (pair_value is null) then
put(pair_name, pljson_null(), position);
else
put(pair_name, pljson_bool(pair_value), position);
end if;
end;
member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value pljson, position pls_integer default null) as
begin
if (pair_value is null) then
put(pair_name, pljson_null(), position);
else
put(pair_name, treat(pair_value as pljson_element), position);
end if;
end;
member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value pljson_list, position pls_integer default null) as
begin
if (pair_value is null) then
put(pair_name, pljson_null(), position);
else
put(pair_name, treat(pair_value as pljson_element), position);
end if;
end;
overriding member function count return number as
begin
return self.json_data.count;
end;
overriding member function get(pair_name varchar2) return pljson_element as
indx pls_integer;
begin
indx := json_data.first;
loop
exit when indx is null;
if (pair_name is null and json_data(indx).mapname is null) then return json_data(indx); end if;
if (json_data(indx).mapname = pair_name) then return json_data(indx); end if;
indx := json_data.next(indx);
end loop;
return null;
end;
member function get_string(pair_name varchar2) return varchar2 as
elem pljson_element := get(pair_name);
begin
if elem is not null and elem is of (pljson_string) then
return elem.get_string();
end if;
return null;
end;
member function get_clob(pair_name varchar2) return clob as
elem pljson_element := get(pair_name);
begin
if elem is not null and elem is of (pljson_string) then
return elem.get_clob();
end if;
return null;
end;
member function get_number(pair_name varchar2) return number as
elem pljson_element := get(pair_name);
begin
if elem is not null and elem is of (pljson_number) then
return elem.get_number();
end if;
return null;
end;
member function get_double(pair_name varchar2) return binary_double as
elem pljson_element := get(pair_name);
begin
if elem is not null and elem is of (pljson_number) then
return elem.get_double();
end if;
return null;
end;
member function get_bool(pair_name varchar2) return boolean as
elem pljson_element := get(pair_name);
begin
if elem is not null and elem is of (pljson_bool) then
return elem.get_bool();
end if;
return null;
end;
member function get_pljson(pair_name varchar2) return pljson as
elem pljson_element := get(pair_name);
begin
if elem is not null and elem is of (pljson) then
return treat(elem as pljson);
end if;
return null;
end;
member function get_pljson_list(pair_name varchar2) return pljson_list as
elem pljson_element := get(pair_name);
begin
if elem is not null and elem is of (pljson_list) then
return treat(elem as pljson_list);
end if;
return null;
end;
overriding member function get(position pls_integer) return pljson_element as
begin
if (self.count >= position and position > 0) then
return self.json_data(position);
end if;
return null; -- do not throw error, just return null
end;
member function index_of(pair_name varchar2) return number as
indx pls_integer;
begin
indx := json_data.first;
loop
exit when indx is null;
if (pair_name is null and json_data(indx).mapname is null) then return indx; end if;
if (json_data(indx).mapname = pair_name) then return indx; end if;
indx := json_data.next(indx);
end loop;
return -1;
end;
member function exist(pair_name varchar2) return boolean as
begin
return (get(pair_name) is not null);
end;
member procedure check_duplicate(self in out nocopy pljson, v_set boolean) as
begin
if (v_set) then
check_for_duplicate := 1;
else
check_for_duplicate := 0;
end if;
end;
member procedure remove_duplicates(self in out nocopy pljson) as
begin
pljson_parser.remove_duplicates(self);
end remove_duplicates;
/* json path */
overriding member function path(json_path varchar2, base number default 1) return pljson_element as
begin
return pljson_ext.get_json_element(self, json_path, base);
end path;
/* json path_put */
member procedure path_put(self in out nocopy pljson, json_path varchar2, elem pljson_element, base number default 1) as
begin
pljson_ext.put(self, json_path, elem, base);
end path_put;
member procedure path_put(self in out nocopy pljson, json_path varchar2, elem varchar2, base number default 1) as
begin
if (elem is null and pljson_parser.empty_string_as_null) then
pljson_ext.put(self, json_path, pljson_null(), base);
else
pljson_ext.put(self, json_path, elem, base);
end if;
end path_put;
member procedure path_put(self in out nocopy pljson, json_path varchar2, elem clob, base number default 1) as
begin
if (elem is null) then
pljson_ext.put(self, json_path, pljson_null(), base);
else
pljson_ext.put(self, json_path, elem, base);
end if;
end path_put;
member procedure path_put(self in out nocopy pljson, json_path varchar2, elem number, base number default 1) as
begin
if (elem is null) then
pljson_ext.put(self, json_path, pljson_null(), base);
else
pljson_ext.put(self, json_path, elem, base);
end if;
end path_put;
/* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */
member procedure path_put(self in out nocopy pljson, json_path varchar2, elem binary_double, base number default 1) as
begin
if (elem is null) then
pljson_ext.put(self, json_path, pljson_null(), base);
else
pljson_ext.put(self, json_path, elem, base);
end if;
end path_put;
member procedure path_put(self in out nocopy pljson, json_path varchar2, elem boolean, base number default 1) as
begin
if (elem is null) then
pljson_ext.put(self, json_path, pljson_null(), base);
else
pljson_ext.put(self, json_path, elem, base);
end if;
end path_put;
member procedure path_put(self in out nocopy pljson, json_path varchar2, elem pljson_list, base number default 1) as
begin
if (elem is null) then
pljson_ext.put(self, json_path, pljson_null(), base);
else
pljson_ext.put(self, json_path, elem, base);
end if;
end path_put;
member procedure path_put(self in out nocopy pljson, json_path varchar2, elem pljson, base number default 1) as
begin
if (elem is null) then
pljson_ext.put(self, json_path, pljson_null(), base);
else
pljson_ext.put(self, json_path, elem, base);
end if;
end path_put;
member procedure path_remove(self in out nocopy pljson, json_path varchar2, base number default 1) as
begin
pljson_ext.remove(self, json_path, base);
end path_remove;
/* Thanks to Matt Nolan */
member function get_keys return pljson_list as
keys pljson_list;
indx pls_integer;
begin
keys := pljson_list();
indx := json_data.first;
loop
exit when indx is null;
keys.append(json_data(indx).mapname);
indx := json_data.next(indx);
end loop;
return keys;
end;
member function get_values return pljson_list as
vals pljson_list := pljson_list();
begin
vals.list_data := self.json_data;
return vals;
end;
/* private method for internal use, not part of the API, contributed by @asfernandes */
overriding member procedure get_internal_path(self in pljson, path pljson_path, path_position pls_integer, ret out nocopy pljson_element) as
indx pls_integer := path(path_position).indx;
begin
if (indx is null) then
indx := self.json_data.first;
loop
exit when indx is null;
if ((path(path_position).name is null and self.json_data(indx).mapname is null) or
(self.json_data(indx).mapname = path(path_position).name))
then
if (path_position < path.count) then
self.json_data(indx).get_internal_path(path, path_position + 1, ret);
else
ret := self.json_data(indx);
end if;
exit;
end if;
indx := self.json_data.next(indx);
end loop;
else
if (indx <= self.json_data.count) then
if (path_position < path.count) then
self.json_data(indx).get_internal_path(path, path_position + 1, ret);
else
ret := self.json_data(indx);
end if;
end if;
end if;
end;
/* private method for internal use, not part of the API, contributed by @asfernandes */
overriding member function put_internal_path(self in out nocopy pljson, path pljson_path, elem pljson_element, path_position pls_integer) return boolean as
indx pls_integer;
keystring varchar2(4000);
new_obj pljson;
new_list pljson_list;
ret boolean := false;
begin
if (path(path_position).indx is null) then
keystring := path(path_position).name;
else
if (path(path_position).indx > self.json_data.count) then
if (elem is null) then
return false;
end if;
raise_application_error(-20110, 'PLJSON_EXT put error: access object with too few members.');
end if;
keystring := self.json_data(path(path_position).indx).mapname;
end if;
indx := self.json_data.first;
loop
exit when indx is null;
if ((keystring is null and self.json_data(indx).mapname is null) or (self.json_data(indx).mapname = keystring)) then
if (path_position < path.count) then
if (path(path_position + 1).indx is null) then
if (not self.json_data(indx).is_object()) then
if (elem is not null) then
put(keystring, pljson());
else
return false;
end if;
end if;
else
if (not self.json_data(indx).is_object() and not self.json_data(indx).is_array()) then
if (elem is not null) then
put(keystring, pljson_list());
else
return false;
end if;
end if;
end if;
if (self.json_data(indx).put_internal_path(path, elem, path_position + 1)) then
self.remove(keystring);
return true;
end if;
else
if (elem is null) then
self.remove(keystring);
return true;
else
self.put(keystring, elem);
end if;
end if;
return false;
end if;
indx := self.json_data.next(indx);
end loop;
if (elem is not null) then
if (path_position = path.count) then
put(keystring, elem);
else
if (path(path_position + 1).indx is null) then
new_obj := pljson();
ret := new_obj.put_internal_path(path, elem, path_position + 1);
put(keystring, new_obj);
else
new_list := pljson_list();
ret := new_list.put_internal_path(path, elem, path_position + 1);
put(keystring, new_list);
end if;
end if;
end if;
return ret;
end;
end;
/
show err
-- ====================================================================
-- STEP 5: GRANT EXECUTE la PUBLIC
-- ====================================================================
PROMPT [5/6] Grant EXECUTE to PUBLIC...;
GRANT EXECUTE ON pljson_path_segment TO PUBLIC;
GRANT EXECUTE ON pljson_path TO PUBLIC;
GRANT EXECUTE ON pljson_element TO PUBLIC;
GRANT EXECUTE ON pljson_element_array TO PUBLIC;
GRANT EXECUTE ON pljson_varray TO PUBLIC;
GRANT EXECUTE ON pljson_narray TO PUBLIC;
GRANT EXECUTE ON pljson_list TO PUBLIC;
GRANT EXECUTE ON pljson TO PUBLIC;
GRANT EXECUTE ON pljson_string TO PUBLIC;
GRANT EXECUTE ON pljson_number TO PUBLIC;
GRANT EXECUTE ON pljson_bool TO PUBLIC;
GRANT EXECUTE ON pljson_null TO PUBLIC;
GRANT EXECUTE ON pljson_parser TO PUBLIC;
GRANT EXECUTE ON pljson_printer TO PUBLIC;
GRANT EXECUTE ON pljson_ext TO PUBLIC;
-- ====================================================================
-- STEP 6: PUBLIC SYNONYMS
-- ====================================================================
PROMPT [6/6] Creare PUBLIC SYNONYMS...;
CREATE PUBLIC SYNONYM pljson_path_segment FOR CONTAFIN_ORACLE.pljson_path_segment;
CREATE PUBLIC SYNONYM pljson_path FOR CONTAFIN_ORACLE.pljson_path;
CREATE PUBLIC SYNONYM pljson_element FOR CONTAFIN_ORACLE.pljson_element;
CREATE PUBLIC SYNONYM pljson_element_array FOR CONTAFIN_ORACLE.pljson_element_array;
CREATE PUBLIC SYNONYM pljson_varray FOR CONTAFIN_ORACLE.pljson_varray;
CREATE PUBLIC SYNONYM pljson_narray FOR CONTAFIN_ORACLE.pljson_narray;
CREATE PUBLIC SYNONYM pljson_list FOR CONTAFIN_ORACLE.pljson_list;
CREATE PUBLIC SYNONYM pljson FOR CONTAFIN_ORACLE.pljson;
CREATE PUBLIC SYNONYM pljson_string FOR CONTAFIN_ORACLE.pljson_string;
CREATE PUBLIC SYNONYM pljson_number FOR CONTAFIN_ORACLE.pljson_number;
CREATE PUBLIC SYNONYM pljson_bool FOR CONTAFIN_ORACLE.pljson_bool;
CREATE PUBLIC SYNONYM pljson_null FOR CONTAFIN_ORACLE.pljson_null;
CREATE PUBLIC SYNONYM pljson_parser FOR CONTAFIN_ORACLE.pljson_parser;
CREATE PUBLIC SYNONYM pljson_printer FOR CONTAFIN_ORACLE.pljson_printer;
CREATE PUBLIC SYNONYM pljson_ext FOR CONTAFIN_ORACLE.pljson_ext;
-- ====================================================================
-- Verificare
-- ====================================================================
PROMPT;
PROMPT Verificare obiecte create:;
SELECT object_name, object_type, status
FROM user_objects
WHERE object_name LIKE 'PLJSON%'
ORDER BY object_type, object_name;
PROMPT;
PROMPT Test rapid:;
DECLARE
v_arr pljson_list;
v_obj pljson;
v_sku VARCHAR2(100);
BEGIN
v_arr := pljson_list('[{"sku":"TEST1","price":"10.5"},{"sku":"TEST2","price":"25.0"}]');
FOR i IN 1 .. v_arr.count LOOP
v_obj := pljson(v_arr.get(i));
v_sku := v_obj.get_string('sku');
DBMS_OUTPUT.PUT_LINE(' Articol ' || i || ': SKU=' || v_sku || ', pret=' || v_obj.get_string('price'));
END LOOP;
DBMS_OUTPUT.PUT_LINE('PL/JSON instalat cu succes!');
END;
/
exec contafin_oracle.pack_migrare.UpdateVersiune('co_2026_03_16_01_COMUN_PLJSON');
commit;
PROMPT;
PROMPT =============================================;
PROMPT Instalare PL/JSON completa!;
PROMPT =============================================;
PROMPT;
Reference in New Issue View Git Blame Copy Permalink