CREATE OR REPLACE PACKAGE create_xml IS
-- Declare XML types
type ry_path is record (
full_path varchar2(4000),
node_name varchar2(512),
node_path varchar2(4000),
attb_name varchar2(512),
attb_path varchar2(4000)
);
-- Constants
c_path_sep CONSTANT varchar2(1) := '/';
c_attb_sep CONSTANT varchar2(1) := '@';
c_function_sep_start CONSTANT varchar2(1) := '[';
c_function_sep_end CONSTANT varchar2(1) := ']';
-- Initialize XML
procedure init_xml(
p_domdoc in out dbms_xmldom.DOMDocument,
p_index_id in varchar2,
p_node_name in varchar2,
p_text_value in varchar2
);
-- Add and write node to XML DOMDocument
procedure create_node(
p_domdoc in out dbms_xmldom.DOMDocument,
p_index_id in varchar2,
p_node_name in varchar2,
p_text_value in varchar2
);
-- Add attribute to XML DOMDocument
procedure add_attr(
p_index_id in varchar2,
p_attr_name in varchar2,
p_text_value in varchar2
);
-- Add node or attribute to XML DOMDocument (path notation)
procedure add_element(
p_path in varchar2,
p_value in varchar2,
p_domdoc in out dbms_xmldom.DOMDocument
);
-- Tokenize Path expresion
function tokenize_path(
p_path in varchar2,
p_path_sep in varchar2 default c_path_sep,
p_attb_sep in varchar2 default c_attb_sep,
p_function_sep_start in varchar2 default c_function_sep_start,
p_function_sep_end in varchar2 default c_function_sep_end
) return ry_path;
-- Get parent in Path expresion
function get_parent(
p_path in varchar2
) return varchar2;
-- Write XML DOM to Blob
procedure write_xmldom2blob (
p_domdoc in dbms_xmldom.DOMDocument,
p_csid in number,
p_blob in out nocopy blob
);
-- Create an example
procedure xml_example;
END create_xml;
CREATE OR REPLACE PACKAGE BODY create_xml AS
-- Private types
-- Internal XML types
type ry_xmlelement is record (
p_parent dbms_xmldom.DOMNode,
p_element_name varchar2(512),
p_element dbms_xmldom.DOMElement,
p_node dbms_xmldom.DOMNode,
p_text_value varchar2(32767),
p_text dbms_xmldom.DOMText,
p_textnode dbms_xmldom.DOMNode
);
type ty_xmlelement is table of ry_xmlelement index by varchar2(32767);
-- Internal variables
tb_xmlelements ty_xmlelement;
-- Private functions and procedures
-- Add node to ty_xmlelement
procedure add_node(
p_index_id in varchar2,
p_node_name in varchar2,
p_text_value in varchar2
)
is
begin
-- Add node
tb_xmlelements(p_index_id).p_parent := tb_xmlelements(get_parent(p_index_id)).p_node;
tb_xmlelements(p_index_id).p_element_name := p_node_name;
tb_xmlelements(p_index_id).p_text_value := p_text_value;
end add_node;
-- Write node to XML DOMDocument
procedure write_node(
p_domdoc in out dbms_xmldom.DOMDocument,
p_index_id in varchar2
)
is
begin
-- Write node
tb_xmlelements(p_index_id).p_element := dbms_xmldom.createElement(p_domdoc, tb_xmlelements(p_index_id).p_element_name);
tb_xmlelements(p_index_id).p_node := dbms_xmldom.appendChild(tb_xmlelements(p_index_id).p_parent,dbms_xmldom.makeNode(tb_xmlelements(p_index_id).p_element));
tb_xmlelements(p_index_id).p_text := dbms_xmldom.createTextNode(p_domdoc, tb_xmlelements(p_index_id).p_text_value);
tb_xmlelements(p_index_id).p_textnode := dbms_xmldom.appendChild(tb_xmlelements(p_index_id).p_node,dbms_xmldom.makeNode(tb_xmlelements(p_index_id).p_text));
end write_node;
-- Public functions and procedures
-- Initialize XML
procedure init_xml(
p_domdoc in out dbms_xmldom.DOMDocument,
p_index_id in varchar2,
p_node_name in varchar2,
p_text_value in varchar2
)
is
l_root_node dbms_xmldom.DOMNode;
begin
-- Init internal table
tb_xmlelements.delete;
-- Create a root node
l_root_node := dbms_xmldom.makeNode(p_domdoc);
tb_xmlelements(p_index_id).p_parent := l_root_node;
tb_xmlelements(p_index_id).p_element_name := p_node_name;
tb_xmlelements(p_index_id).p_text_value := p_text_value;
write_node(p_domdoc, p_index_id);
end init_xml;
-- Add node to XML DOMDocument
procedure create_node(
p_domdoc in out dbms_xmldom.DOMDocument,
p_index_id in varchar2,
p_node_name in varchar2,
p_text_value in varchar2
)
is
begin
-- Add node
add_node(p_index_id, p_node_name, p_text_value);
-- Write node
write_node(p_domdoc, p_index_id);
end create_node;
-- Add attribute to XML DOMDocument
procedure add_attr(
p_index_id in varchar2,
p_attr_name in varchar2,
p_text_value in varchar2
)
is
begin
-- Add attribute
dbms_xmldom.setAttribute(
tb_xmlelements(p_index_id).p_element,
p_attr_name,
p_text_value);
end add_attr;
-- Add node or attribute to XML DOMDocument (path notation)
procedure add_element(
p_path in varchar2,
p_value in varchar2,
p_domdoc in out dbms_xmldom.DOMDocument
)
is
reg_path ry_path;
begin
-- Read p_path
reg_path := tokenize_path(p_path => p_path);
-- Switch node / attribute
if reg_path.attb_name is not null then
add_attr(
p_index_id => reg_path.attb_path,
p_attr_name => reg_path.attb_name,
p_text_value => p_value
);
else
create_node(
p_domdoc => p_domdoc,
p_index_id => reg_path.full_path,
p_node_name => reg_path.node_name,
p_text_value => p_value
);
end if;
end add_element;
-- Tokenize Path expresion
function tokenize_path(
p_path in varchar2,
p_path_sep in varchar2 default c_path_sep,
p_attb_sep in varchar2 default c_attb_sep,
p_function_sep_start in varchar2 default c_function_sep_start,
p_function_sep_end in varchar2 default c_function_sep_end
) return ry_path
is
v_path_sep varchar2(1);
v_attb_sep varchar2(1);
v_function_sep_start varchar2(1);
v_function_sep_end varchar2(1);
reg_path ry_path;
begin
-- Init variables
v_path_sep := nvl(p_path_sep, c_path_sep);
v_attb_sep := nvl(p_attb_sep, c_attb_sep);
v_function_sep_start := nvl(p_function_sep_start, c_function_sep_start);
v_function_sep_end := nvl(p_function_sep_end, c_function_sep_end);
reg_path.full_path := p_path;
-- Remove end path_sep
if substr(reg_path.full_path, -1, 1) = v_path_sep then
reg_path.full_path := substr(reg_path.full_path, 1, length(reg_path.full_path)-1);
end if;
-- Check for attrib
if instr(reg_path.full_path, v_path_sep||v_attb_sep, 1, 2) > 1 then
raise_application_error(-20001, 'Only one '||v_attb_sep||' is allowed.', true);
elsif instr(reg_path.full_path, v_path_sep||v_attb_sep) > 0 then
reg_path.attb_name := substr(reg_path.full_path, instr(reg_path.full_path, v_path_sep||v_attb_sep)+2);
reg_path.attb_path := substr(reg_path.full_path, 1, instr(reg_path.full_path, v_path_sep||v_attb_sep, -1)-1);
reg_path.node_path := substr(reg_path.full_path, 1, instr(reg_path.full_path, v_path_sep||v_attb_sep, -1)-1);
else
reg_path.node_path := reg_path.full_path;
end if;
-- Tokenize node
reg_path.node_name := regexp_substr(
regexp_substr(reg_path.node_path, '[^'||v_path_sep||']+$'),
'[^'||v_function_sep_start||'|'||v_path_sep||v_attb_sep||']+');
reg_path.node_path := substr(reg_path.node_path, 1, instr(reg_path.node_path, v_path_sep, -1)-1);
-- End
return reg_path;
end tokenize_path;
-- Get parent in Path expresion
function get_parent(
p_path in varchar2
) return varchar2
is
reg_path ry_path;
begin
-- Extract parent
reg_path := tokenize_path(p_path => p_path);
return reg_path.node_path;
end get_parent;
-- Write XML DOM to Blob
procedure write_xmldom2blob (
p_domdoc in dbms_xmldom.DOMDocument,
p_csid in number,
p_blob in out nocopy blob
)
is
cl_xml clob;
dest_offset integer := 1;
src_offset integer := 1;
lang_context integer := 0;
warning integer;
begin
-- Init variables
dbms_lob.createtemporary(lob_loc => cl_xml, cache => false, dur => dbms_lob.call);
-- Write XML DOM to Clob
dbms_xmldom.writeToClob(doc => p_domdoc, cl => cl_xml);
-- Convert Clob to Blob
dbms_lob.convertToBlob(
dest_lob => p_blob,
src_clob => cl_xml,
amount => dbms_lob.lobmaxsize,
dest_offset => dest_offset,
src_offset => src_offset,
blob_csid => p_csid,
lang_context => lang_context,
warning => warning);
-- Free resources
dbms_lob.freetemporary(lob_loc => cl_xml);
end write_xmldom2blob;
-- Create an example
procedure xml_example
IS
l_domdoc dbms_xmldom.DOMDocument;
v_buffer varchar2(32767);
begin
-- Create an empty XML document
l_domdoc := dbms_xmldom.newDomDocument;
-- Set version
dbms_xmldom.setVersion(l_domdoc, '1.0" encoding="ISO-8859-1');
--dbms_xmldom.setVersion(l_domdoc, '1.0');
--dbms_xmldom.setCharset(l_domdoc, 'ISO-8859-1');
-- Init XML
create_xml.init_xml(l_domdoc, '/root', 'root', null);
-- Add attributes to root node
create_xml.add_element('/root/@RootAttr01', 'Root Atribute 01', l_domdoc);
create_xml.add_element('/root/@RootAttr02', 'Root Atribute 02', l_domdoc);
-- Create a new node with text and attributes
create_xml.add_element('/root/node[1]', 'Node 01 text', l_domdoc);
create_xml.add_element('/root/node[1]/@Attr01', 'Atribute 01', l_domdoc);
create_xml.add_element('/root/node[1]/@Attr02', 'Atribute 02', l_domdoc);
-- Create a additional node with text
create_xml.add_element('/root/node[2]', '', l_domdoc);
-- Create a additional node paretn with child nodes
create_xml.add_element('/root/node_parent', '', l_domdoc);
create_xml.add_element('/root/node_parent/@AttrNew01', 'text attr new 01', l_domdoc);
create_xml.add_element('/root/node_parent/node_child[1]', 'Node Child aáa text 01', l_domdoc);
create_xml.add_element('/root/node_parent/node_child[2]', 'Node Child text 02', l_domdoc);
create_xml.add_element('/root/node_parent/node_child[3]', 'Node Child text 03', l_domdoc);
-- Add child to /root/node02
create_xml.add_element('/root/node[2]/node_child', 'Node 02 Child', l_domdoc);
-- Result
dbms_xmldom.writeToBuffer(l_domdoc, v_buffer, 'ISO-8859-1');
$if not dbms_db_version.ver_le_10_2 $then
select xmlserialize(DOCUMENT xmltype(v_buffer) AS varchar2(4000) INDENT) into v_buffer from dual;
$end
dbms_output.put_line(v_buffer);
dbms_xmldom.freeDocument(l_domdoc);
end xml_example;
END create_xml;
El paquete cuenta con un procedimiento de ejemplo:
begin
create_xml.xml_example;
end;
Resultado:
<?xml version="1.0" encoding="ISO-8859-1"?>
<root RootAttr01="Root Atribute 01" RootAttr02="Root Atribute 02">
<node Attr01="Atribute 01" Attr02="Atribute 02">Node 01 text</node>
<node>
<node>Node 02 Child</node>
</node>
<node AttrNew01="text attr new 01">
<node>Node Child aáa text 01</node>
<node Attr="Node Child 02 Attribute">Node Child text 02</node>
<node>Node Child text 03</node>
</node>
</root>
desc EMP 