dnviti/apollinare-catering-software
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

extracted objects

Browse Source
This commit is contained in:
Daniele Viti
2025-12-17 13:02:12 +01:00
commit 7dd4ea08e1
195 changed files with 70591 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

392
docs/packages/MAIL_PKG.md Normal file
View File

@@ -0,0 +1,392 @@
# MAIL_PKG
## Package Specification
```sql
PACKAGE MAIL_PKG AS
--==================================================================================
-- SPECIFICA DEL PACKAGE
-- Aggiunta delle nuove procedure per il reminder della seconda caparra.
-- Ultima modifica: 26/07/2024
--==================================================================================
-- Procedura generica per inviare email
procedure send_custom_mail(p_recipients varchar2, p_subject varchar2, p_body varchar2);
-- Procedure esistenti
PROCEDURE send_richiesta_riscontro_preventivo (
p_style_id NUMBER DEFAULT 1,
p_evento_id NUMBER
);
PROCEDURE send_richiesta_riscontro_preventivo_job;
PROCEDURE send_richiesta_riscontro_post_degustazione (
p_style_id NUMBER DEFAULT 1,
p_evento_id NUMBER
);
PROCEDURE send_richiesta_riscontro_post_degustazione_job;
-- ===============================================================================
-- NUOVE PROCEDURE PER IL REMINDER DELLA SECONDA CAPARRA
-- Data creazione: 26/07/2024
-- ===============================================================================
/**
* @descr Costruisce e invia la mail di sollecito per la seconda caparra per un dato evento.
* @param p_style_id ID dello stile HTML da applicare alla mail.
* @param p_evento_id ID dell'evento per cui inviare la notifica.
*/
PROCEDURE send_reminder_seconda_caparra (
p_style_id NUMBER DEFAULT 1,
p_evento_id NUMBER
);
/**
* @descr Job che seleziona gli eventi per cui inviare il sollecito della seconda caparra.
* Il primo invio avviene 65 giorni prima dell'evento.
* Gli invii successivi avvengono ogni 5 giorni fino alla data dell'evento,
* se la seconda caparra non risulta ancora pagata.
*/
PROCEDURE send_reminder_seconda_caparra_job;
END MAIL_PKG;
```
## Package Body
```sql
PACKAGE BODY MAIL_PKG AS
--==================================================================================
-- BODY DEL PACKAGE
-- Implementazione delle nuove procedure e mantenimento di quelle esistenti.
-- Ultima modifica: 25/07/2024
--==================================================================================
/**
* @descr Procedura di utility generica per inviare una mail tramite APEX_MAIL.
* @param p_recipients Lista di destinatari separati da virgola.
* @param p_subject Oggetto della mail.
* @param p_body Corpo della mail (può contenere HTML).
*/
procedure send_custom_mail(p_recipients varchar2, p_subject varchar2, p_body varchar2) AS
BEGIN
-- Se non ci sono destinatari, interrompe l'esecuzione.
if trim(p_recipients) is null
then
return;
end if;
-- Utilizza il package APEX_MAIL per comporre e inviare l'email.
APEX_MAIL.SEND(
p_to => p_recipients,
p_from => 'noreply@apollinarecatering.it',
p_bcc => 'monia@apollinarecatering.it, matrimonio@apollinarecatering.it',
--p_bcc => 'monia@apollinarecatering.it, maria@apollinarecatering.it', -- Copia conoscenza nascosta
p_subj => p_subject,
p_body => p_body,
p_body_html => p_body -- Il corpo viene inviato sia come testo che come HTML.
);
-- Forza l'invio immediato delle mail presenti nella coda di APEX.
APEX_MAIL.PUSH_QUEUE;
END send_custom_mail;
/**
* @descr Invia una mail di sollecito per avere un riscontro su un preventivo inviato per eventi in stato preventivo (100) o scheda confermata (200).
* @param p_style_id ID dello stile HTML da usare per il corpo della mail.
* @param p_evento_id ID dell'evento a cui la mail fa riferimento.
*/
PROCEDURE send_richiesta_riscontro_preventivo (
p_style_id NUMBER DEFAULT 1,
p_evento_id NUMBER
) AS
v_evento eventi%ROWTYPE;
v_location location%ROWTYPE;
BEGIN
-- Imposta la lingua e il formato della data della sessione per garantire la corretta formattazione.
EXECUTE IMMEDIATE 'ALTER SESSION SET NLS_LANGUAGE="ITALIAN"';
EXECUTE IMMEDIATE 'ALTER SESSION SET NLS_DATE_FORMAT="DD-MON-YYYY"';
-- Recupera i dettagli dell'evento e della location.
BEGIN
-- Seleziona i dati dell'evento solo se le mail sono abilitate (mail_enabled > 0).
SELECT e.* INTO v_evento
FROM eventi e
WHERE e.id = p_evento_id
AND e.stato in (100, 200)
AND e.mail_enabled > 0;
-- Seleziona i dati della location associata all'evento.
SELECT l.* INTO v_location
FROM location l
WHERE l.id = v_evento.id_location;
EXCEPTION
-- Se l'evento non viene trovato (o ha le mail disabilitate), la procedura termina.
WHEN NO_DATA_FOUND THEN RETURN;
END;
-- Inizializza il corpo della mail e imposta lo stile HTML.
CMN_MAIL_HTMLUTILS.mailbody := '';
CMN_MAIL_HTMLUTILS.set_style(p_style_id);
-- Costruisce il corpo della mail paragrafo per paragrafo utilizzando il package di utility.
CMN_MAIL_HTMLUTILS.create_paragraph('Gentilissimi,');
CMN_MAIL_HTMLUTILS.create_paragraph(
'in seguito all''invio della nostra proposta per il vostro evento, '||
'desideriamo sapere se avete avuto modo di valutarla e se siete interessati ai nostri servizi.'
);
CMN_MAIL_HTMLUTILS.create_paragraph(
'Saremmo lieti di incontrarvi per una degustazione, così da potervi presentare al meglio le nostre offerte. '||
'Potete prenotare una delle date disponibili direttamente tramite il nostro sito: '||
'<a href="https://www.apollinarecatering.it/degustazioni/">Degustazioni</a>.'
);
CMN_MAIL_HTMLUTILS.create_paragraph(
'Per qualsiasi ulteriore informazione o chiarimento potete scriverci a '||
'<a href="mailto:info@apollinarecatering.it">info@apollinarecatering.it</a>.'
);
CMN_MAIL_HTMLUTILS.create_paragraph('<b>Si prega di non rispondere direttamente a questa email.</b>');
CMN_MAIL_HTMLUTILS.create_paragraph('Cordiali saluti,');
CMN_MAIL_HTMLUTILS.create_paragraph('<b>Ufficio Commerciale</b>');
CMN_MAIL_HTMLUTILS.create_paragraph('📞 +39 0743 45 449');
CMN_MAIL_HTMLUTILS.create_paragraph('<b>Apollinare Catering</b>');
-- Invia la mail usando APEX_MAIL, componendo un oggetto dinamico.
APEX_MAIL.SEND(
p_to => v_evento.cliente_email,
p_from => 'noreply@apollinarecatering.it',
p_bcc => 'monia@apollinarecatering.it, matrimonio@apollinarecatering.it',
--p_bcc => 'monia@apollinarecatering.it, maria@apollinarecatering.it',
p_subj => 'Apollinare – richiesta riscontro per evento del '||
TO_CHAR(v_evento.data, 'DD/MM/YYYY')||' presso '||v_location.location,
p_body => CMN_MAIL_HTMLUTILS.mailbody,
p_body_html => CMN_MAIL_HTMLUTILS.mailbody
);
-- Forza l'invio immediato dalla coda di APEX.
APEX_MAIL.PUSH_QUEUE;
END send_richiesta_riscontro_preventivo;
/**
* @descr Invia una mail di sollecito dopo che il cliente ha partecipato a una degustazione.
* @param p_style_id ID dello stile HTML da usare per il corpo della mail.
* @param p_evento_id ID dell'evento a cui la mail fa riferimento.
*/
PROCEDURE send_richiesta_riscontro_post_degustazione (
p_style_id NUMBER DEFAULT 1,
p_evento_id NUMBER
) AS
v_evento eventi%ROWTYPE;
v_location location%ROWTYPE;
BEGIN
-- Imposta la lingua e il formato della data della sessione.
EXECUTE IMMEDIATE 'ALTER SESSION SET NLS_LANGUAGE="ITALIAN"';
EXECUTE IMMEDIATE 'ALTER SESSION SET NLS_DATE_FORMAT="DD-MON-YYYY"';
-- Recupera i dettagli dell'evento e della location.
BEGIN
-- Seleziona i dati dell'evento solo se le mail sono abilitate.
SELECT e.* INTO v_evento
FROM eventi e
WHERE e.id = p_evento_id
AND e.stato in (200)
AND e.mail_enabled > 0;
-- Seleziona i dati della location.
SELECT l.* INTO v_location
FROM location l
WHERE l.id = v_evento.id_location;
EXCEPTION
-- Se non trova l'evento, esce dalla procedura.
WHEN NO_DATA_FOUND THEN RETURN;
END;
-- Inizializza il corpo della mail e imposta lo stile HTML.
CMN_MAIL_HTMLUTILS.mailbody := '';
CMN_MAIL_HTMLUTILS.set_style(p_style_id);
-- Costruisce il corpo della mail.
CMN_MAIL_HTMLUTILS.create_paragraph('Gentilissimi,');
CMN_MAIL_HTMLUTILS.create_paragraph(
'in seguito alla degustazione effettuata per il vostro evento, '||
'desideriamo sapere se la nostra proposta risponde alle vostre aspettative '||
'e se intendete procedere con la conferma dei servizi.'
);
CMN_MAIL_HTMLUTILS.create_paragraph(
'Per ogni ulteriore chiarimento siamo a vostra completa disposizione: '||
'<a href="mailto:info@apollinarecatering.it">info@apollinarecatering.it</a>.'
);
CMN_MAIL_HTMLUTILS.create_paragraph('<b>Si prega di non rispondere direttamente a questa email.</b>');
CMN_MAIL_HTMLUTILS.create_paragraph('Cordiali saluti,');
CMN_MAIL_HTMLUTILS.create_paragraph('<b>Ufficio Commerciale</b>');
CMN_MAIL_HTMLUTILS.create_paragraph('📞 +39 0743 45 449');
CMN_MAIL_HTMLUTILS.create_paragraph('<b>Apollinare Catering</b>');
-- Invia la mail, componendo un oggetto dinamico con data e location.
APEX_MAIL.SEND(
p_to => v_evento.cliente_email,
p_from => 'noreply@apollinarecatering.it',
p_bcc => 'monia@apollinarecatering.it, matrimonio@apollinarecatering.it',
--p_bcc => 'monia@apollinarecatering.it, maria@apollinarecatering.it',
p_subj => 'Apollinare – riscontro post-degustazione evento del '||
TO_CHAR(v_evento.data, 'DD/MM/YYYY')||' presso '||v_location.location,
p_body => CMN_MAIL_HTMLUTILS.mailbody,
p_body_html => CMN_MAIL_HTMLUTILS.mailbody
);
-- Forza l'invio immediato.
APEX_MAIL.PUSH_QUEUE;
END send_richiesta_riscontro_post_degustazione;
/**
* @descr Procedura schedulabile (job) che invia solleciti per i preventivi non confermati.
*/
PROCEDURE send_richiesta_riscontro_preventivo_job AS
BEGIN
-- Itera su tutti gli eventi che soddisfano i criteri per il sollecito.
FOR evt IN (
SELECT e.*
FROM eventi e
WHERE e.stato in (100) -- Stato: Preventivo non confermato
AND e.mail_enabled = 1 -- Mail abilitate
AND TRUNC(e.data_doc) = TRUNC(SYSDATE) - 10 -- Sono passati 10 giorni dalla data del documento.
)
LOOP
-- Per ogni evento trovato, chiama la procedura di invio mail.
send_richiesta_riscontro_preventivo(
p_style_id => 1,
p_evento_id => evt.id
);
END LOOP;
END send_richiesta_riscontro_preventivo_job;
/**
* @descr Procedura schedulabile (job) che invia solleciti dopo una degustazione.
*/
PROCEDURE send_richiesta_riscontro_post_degustazione_job AS
BEGIN
-- Itera su tutti gli eventi che soddisfano i criteri per il sollecito post-degustazione.
FOR evt IN (
SELECT e.*
FROM eventi e
JOIN ( -- Sottoquery per trovare la data della prima degustazione per ogni evento.
SELECT id_evento,
MIN(TRUNC(data)) AS min_data
FROM eventi_det_degust
GROUP BY id_evento ) dm
ON dm.id_evento = e.id
WHERE e.stato = 200 -- Stato: Scheda evento in preparazione
AND e.mail_enabled = 1 -- Mail abilitate
AND dm.min_data = TRUNC(SYSDATE) - 15 -- Sono passati 15 giorni dalla prima degustazione.
)
LOOP
-- Per ogni evento trovato, chiama la procedura di invio mail.
send_richiesta_riscontro_post_degustazione(
p_style_id => 1,
p_evento_id => evt.id
);
END LOOP;
END send_richiesta_riscontro_post_degustazione_job;
-- ===============================================================================
-- IMPLEMENTAZIONE NUOVE PROCEDURE
-- Data creazione: 26/07/2024
-- ===============================================================================
PROCEDURE send_reminder_seconda_caparra (
p_style_id NUMBER DEFAULT 1,
p_evento_id NUMBER
) AS
v_evento eventi%ROWTYPE;
v_location location%ROWTYPE;
BEGIN
EXECUTE IMMEDIATE 'ALTER SESSION SET NLS_LANGUAGE="ITALIAN"';
EXECUTE IMMEDIATE 'ALTER SESSION SET NLS_DATE_FORMAT="DD-MON-YYYY"';
-- Recupero i dati dell'evento e della location
BEGIN
SELECT e.* INTO v_evento
FROM eventi e
WHERE e.id = p_evento_id
AND e.mail_enabled > 0;
SELECT l.* INTO v_location
FROM location l
WHERE l.id = v_evento.id_location;
EXCEPTION
WHEN NO_DATA_FOUND THEN
-- Se l'evento non esiste o le mail sono disabilitate, esco.
RETURN;
END;
-- Costruzione del corpo della mail
CMN_MAIL_HTMLUTILS.mailbody := '';
CMN_MAIL_HTMLUTILS.set_style(p_style_id);
CMN_MAIL_HTMLUTILS.create_paragraph('Gentilissimi,');
CMN_MAIL_HTMLUTILS.create_paragraph(
'sperando che tutto proceda per il meglio, desideriamo cortesemente ricordarvi la scadenza relativa alla seconda tranche di pagamento per il vostro evento.'
);
CMN_MAIL_HTMLUTILS.create_paragraph(
'Qualora non fosse ancora stato effettuato, vi invitiamo a procedere con il versamento della seconda caparra, previsto 60 giorni prima della data dell’evento, come da accordi e indicato nel preventivo.'
);
CMN_MAIL_HTMLUTILS.create_paragraph(
'Rimaniamo a disposizione per qualsiasi chiarimento e vi ringraziamo sin da ora per la preziosa collaborazione.'
);
CMN_MAIL_HTMLUTILS.create_paragraph('Cordiali saluti,');
CMN_MAIL_HTMLUTILS.create_paragraph('<b>Ufficio Commerciale</b>');
CMN_MAIL_HTMLUTILS.create_paragraph('📞 +39 0743 45 449');
CMN_MAIL_HTMLUTILS.create_paragraph('<b>Apollinare Catering</b>');
-- Invio della mail
APEX_MAIL.SEND(
--p_to => v_evento.cliente_email,
p_to => 'amministrazione@apollinarecatering.it',
p_from => 'noreply@apollinarecatering.it',
p_bcc => 'monia@apollinarecatering.it, matrimonio@apollinarecatering.it',
--p_bcc => 'monia@apollinarecatering.it, maria@apollinarecatering.it',
p_subj => 'Apollinare – Promemoria pagamento per evento del '||
TO_CHAR(v_evento.data, 'DD/MM/YYYY'),
p_body => CMN_MAIL_HTMLUTILS.mailbody,
p_body_html => CMN_MAIL_HTMLUTILS.mailbody
);
-- Invio immediato dalla coda
APEX_MAIL.PUSH_QUEUE;
END send_reminder_seconda_caparra;
PROCEDURE send_reminder_seconda_caparra_job AS
BEGIN
-- Scorro tutti gli eventi che necessitano del reminder.
-- La logica ora utilizza la vista GET_EVENTI_DA_PAGARE_ENTRO_65GG
-- per identificare gli eventi che non hanno saldato la caparra.
FOR evt IN (
SELECT
v.id,
v.data -- Seleziono la data per il calcolo del MOD
FROM
GET_EVENTI_DA_PAGARE_ENTRO_65GG v
JOIN
eventi e ON v.id = e.id -- Join per recuperare il flag mail_enabled
WHERE
-- La vista già filtra per stato, importi e finestra di 65 giorni.
-- Aggiungo solo le condizioni specifiche del job.
-- Le mail automatiche devono essere abilitate.
e.mail_enabled = 1
-- La logica MOD assicura l'invio periodico ogni 5 giorni.
AND MOD(65 - (TRUNC(v.data) - TRUNC(SYSDATE)), 5) = 0
)
LOOP
-- Per ogni evento trovato, chiamo la procedura di invio mail.
send_reminder_seconda_caparra(
p_style_id => 1,
p_evento_id => evt.id
);
END LOOP;
END send_reminder_seconda_caparra_job;
END MAIL_PKG;```

341
docs/packages/PLJSON_DYN.md Normal file
View File

@@ -0,0 +1,341 @@
# PLJSON_DYN
## Package Specification
```sql
package pljson_dyn authid current_user 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.
*/
null_as_empty_string boolean not null := true; --varchar2
include_dates boolean not null := true; --date
include_clobs boolean not null := true;
include_blobs boolean not null := false;
include_arrays boolean not null := true; -- pljson_varray or pljson_narray
/* list with objects */
function executeList(stmt varchar2, bindvar pljson default null, cur_num number default null, bindvardateformats pljson default null) return pljson_list;
/* object with lists */
function executeObject(stmt varchar2, bindvar pljson default null, cur_num number default null) return pljson;
/* usage example:
* declare
* res json_list;
* begin
* res := json_dyn.executeList(
* 'select :bindme as one, :lala as two from dual where dummy in :arraybind',
* json('{bindme:"4", lala:123, arraybind:[1, 2, 3, "X"]}')
* );
* res.print;
* end;
*/
/* --11g functions
function executeList(stmt in out sys_refcursor) return json_list;
function executeObject(stmt in out sys_refcursor) return json;
*/
end pljson_dyn;```
## Package Body
```sql
package body pljson_dyn as
/*
-- 11gR2
function executeList(stmt in out sys_refcursor) return json_list as
l_cur number;
begin
l_cur := dbms_sql.to_cursor_number(stmt);
return json_dyn.executeList(null, null, l_cur);
end;
-- 11gR2
function executeObject(stmt in out sys_refcursor) return json as
l_cur number;
begin
l_cur := dbms_sql.to_cursor_number(stmt);
return json_dyn.executeObject(null, null, l_cur);
end;
*/
procedure bind_json(l_cur number, bindvar pljson, bindvardateformats pljson default null) as
keylist pljson_list := bindvar.get_keys();
begin
for i in 1 .. keylist.count loop
if (bindvar.get(i).is_number()) then
dbms_sql.bind_variable(l_cur, ':'||keylist.get(i).get_string(), bindvar.get(i).get_number());
elsif (bindvar.get(i).is_array()) then
declare
v_bind dbms_sql.varchar2_table;
v_arr pljson_list := pljson_list(bindvar.get(i));
begin
for j in 1 .. v_arr.count loop
v_bind(j) := v_arr.get(j).value_of();
end loop;
dbms_sql.bind_array(l_cur, ':'||keylist.get(i).get_string(), v_bind);
end;
else
if bindvardateformats is not null then
if bindvardateformats.exist(keylist.get(i).get_string()) then
dbms_sql.bind_variable(l_cur, ':'||keylist.get(i).get_string(), to_date(bindvar.get(i).value_of(), bindvardateformats.get(keylist.get(i).get_string()).get_string() ));
else
dbms_sql.bind_variable(l_cur, ':'||keylist.get(i).get_string(), bindvar.get(i).value_of());
end if;
else
dbms_sql.bind_variable(l_cur, ':'||keylist.get(i).get_string(), bindvar.get(i).value_of());
end if;
end if;
end loop;
end bind_json;
/* list with objects */
function executeList(stmt varchar2, bindvar pljson, cur_num number, bindvardateformats pljson default null) return pljson_list as
l_cur number;
l_dtbl dbms_sql.desc_tab3;
l_cnt number;
l_status number;
l_val varchar2(4000);
outer_list pljson_list := pljson_list();
inner_obj pljson;
conv number;
read_date date;
read_clob clob;
read_blob blob;
col_type number;
read_varray pljson_varray;
read_narray pljson_narray;
begin
if (cur_num is not null) then
l_cur := cur_num;
else
l_cur := dbms_sql.open_cursor;
dbms_sql.parse(l_cur, stmt, dbms_sql.native);
if (bindvar is not null) then bind_json(l_cur, bindvar, bindvardateformats); end if;
end if;
/* E.I.Sarmas (github.com/dsnz) 2018-05-01 handling of varray, narray in select */
dbms_sql.describe_columns3(l_cur, l_cnt, l_dtbl);
for i in 1..l_cnt loop
col_type := l_dtbl(i).col_type;
--dbms_output.put_line(col_type);
if (col_type = 12) then
dbms_sql.define_column(l_cur, i, read_date);
elsif (col_type = 112) then
dbms_sql.define_column(l_cur, i, read_clob);
elsif (col_type = 113) then
dbms_sql.define_column(l_cur, i, read_blob);
elsif (col_type in (1, 2, 96)) then
dbms_sql.define_column(l_cur, i, l_val, 4000);
/* E.I.Sarmas (github.com/dsnz) 2018-05-01 handling of pljson_varray in select */
elsif (col_type = 109 and l_dtbl(i).col_type_name = 'PLJSON_VARRAY') then
dbms_sql.define_column(l_cur, i, read_varray);
/* E.I.Sarmas (github.com/dsnz) 2018-05-01 handling of pljson_narray in select */
elsif (col_type = 109 and l_dtbl(i).col_type_name = 'PLJSON_NARRAY') then
dbms_sql.define_column(l_cur, i, read_narray);
/* E.I.Sarmas (github.com/dsnz) 2018-05-01 record unhandled col_type */
else
dbms_output.put_line('unhandled col_type =' || col_type);
end if;
end loop;
if (cur_num is null) then l_status := dbms_sql.execute(l_cur); end if;
--loop through rows
while ( dbms_sql.fetch_rows(l_cur) > 0 ) loop
inner_obj := pljson(); --init for each row
inner_obj.check_for_duplicate := 0;
--loop through columns
for i in 1..l_cnt loop
case true
--handling string types
when l_dtbl(i).col_type in (1, 96) then -- varchar2
dbms_sql.column_value(l_cur, i, l_val);
if (l_val is null) then
if (null_as_empty_string) then
inner_obj.put(l_dtbl(i).col_name, ''); --treat as emptystring?
else
inner_obj.put(l_dtbl(i).col_name, pljson_null()); --null
end if;
else
inner_obj.put(l_dtbl(i).col_name, pljson_string(l_val)); --null
end if;
--dbms_output.put_line(l_dtbl(i).col_name||' --> '||l_val||'varchar2' ||l_dtbl(i).col_type);
--handling number types
when l_dtbl(i).col_type = 2 then -- number
dbms_sql.column_value(l_cur, i, l_val);
conv := l_val;
inner_obj.put(l_dtbl(i).col_name, conv);
-- dbms_output.put_line(l_dtbl(i).col_name||' --> '||l_val||'number ' ||l_dtbl(i).col_type);
when l_dtbl(i).col_type = 12 then -- date
if (include_dates) then
dbms_sql.column_value(l_cur, i, read_date);
inner_obj.put(l_dtbl(i).col_name, pljson_ext.to_json_string(read_date));
end if;
--dbms_output.put_line(l_dtbl(i).col_name||' --> '||l_val||'date ' ||l_dtbl(i).col_type);
when l_dtbl(i).col_type = 112 then --clob
if (include_clobs) then
dbms_sql.column_value(l_cur, i, read_clob);
inner_obj.put(l_dtbl(i).col_name, pljson_string(read_clob));
end if;
when l_dtbl(i).col_type = 113 then --blob
if (include_blobs) then
dbms_sql.column_value(l_cur, i, read_blob);
if (dbms_lob.getlength(read_blob) > 0) then
inner_obj.put(l_dtbl(i).col_name, pljson_ext.encode(read_blob));
else
inner_obj.put(l_dtbl(i).col_name, pljson_null());
end if;
end if;
/* E.I.Sarmas (github.com/dsnz) 2018-05-01 handling of pljson_varray in select */
when l_dtbl(i).col_type = 109 and l_dtbl(i).col_type_name = 'PLJSON_VARRAY' then
if (include_arrays) then
dbms_sql.column_value(l_cur, i, read_varray);
inner_obj.put(l_dtbl(i).col_name, pljson_list(read_varray));
end if;
/* E.I.Sarmas (github.com/dsnz) 2018-05-01 handling of pljson_narray in select */
when l_dtbl(i).col_type = 109 and l_dtbl(i).col_type_name = 'PLJSON_NARRAY' then
if (include_arrays) then
dbms_sql.column_value(l_cur, i, read_narray);
inner_obj.put(l_dtbl(i).col_name, pljson_list(read_narray));
end if;
else null; --discard other types
end case;
end loop;
inner_obj.check_for_duplicate := 1;
outer_list.append(inner_obj);
end loop;
dbms_sql.close_cursor(l_cur);
return outer_list;
end executeList;
/* object with lists */
function executeObject(stmt varchar2, bindvar pljson, cur_num number) return pljson as
l_cur number;
l_dtbl dbms_sql.desc_tab;
l_cnt number;
l_status number;
l_val varchar2(4000);
inner_list_names pljson_list := pljson_list();
inner_list_data pljson_list := pljson_list();
data_list pljson_list;
outer_obj pljson := pljson();
conv number;
read_date date;
read_clob clob;
read_blob blob;
col_type number;
begin
if (cur_num is not null) then
l_cur := cur_num;
else
l_cur := dbms_sql.open_cursor;
dbms_sql.parse(l_cur, stmt, dbms_sql.native);
if (bindvar is not null) then bind_json(l_cur, bindvar); end if;
end if;
dbms_sql.describe_columns(l_cur, l_cnt, l_dtbl);
for i in 1..l_cnt loop
col_type := l_dtbl(i).col_type;
if (col_type = 12) then
dbms_sql.define_column(l_cur, i, read_date);
elsif (col_type = 112) then
dbms_sql.define_column(l_cur, i, read_clob);
elsif (col_type = 113) then
dbms_sql.define_column(l_cur, i, read_blob);
elsif (col_type in (1, 2, 96)) then
dbms_sql.define_column(l_cur, i, l_val, 4000);
end if;
end loop;
if (cur_num is null) then l_status := dbms_sql.execute(l_cur); end if;
--build up name_list
for i in 1..l_cnt loop
case l_dtbl(i).col_type
when 1 then inner_list_names.append(l_dtbl(i).col_name);
when 96 then inner_list_names.append(l_dtbl(i).col_name);
when 2 then inner_list_names.append(l_dtbl(i).col_name);
when 12 then if (include_dates) then inner_list_names.append(l_dtbl(i).col_name); end if;
when 112 then if (include_clobs) then inner_list_names.append(l_dtbl(i).col_name); end if;
when 113 then if (include_blobs) then inner_list_names.append(l_dtbl(i).col_name); end if;
else null;
end case;
end loop;
--loop through rows
while ( dbms_sql.fetch_rows(l_cur) > 0 ) loop
data_list := pljson_list();
--loop through columns
for i in 1..l_cnt loop
case true
--handling string types
when l_dtbl(i).col_type in (1, 96) then -- varchar2
dbms_sql.column_value(l_cur, i, l_val);
if (l_val is null) then
if (null_as_empty_string) then
data_list.append(''); --treat as emptystring?
else
data_list.append(pljson_null()); --null
end if;
else
data_list.append(pljson_string(l_val)); --null
end if;
--dbms_output.put_line(l_dtbl(i).col_name||' --> '||l_val||'varchar2' ||l_dtbl(i).col_type);
--handling number types
when l_dtbl(i).col_type = 2 then -- number
dbms_sql.column_value(l_cur, i, l_val);
conv := l_val;
data_list.append(conv);
-- dbms_output.put_line(l_dtbl(i).col_name||' --> '||l_val||'number ' ||l_dtbl(i).col_type);
when l_dtbl(i).col_type = 12 then -- date
if (include_dates) then
dbms_sql.column_value(l_cur, i, read_date);
data_list.append(pljson_ext.to_json_string(read_date));
end if;
--dbms_output.put_line(l_dtbl(i).col_name||' --> '||l_val||'date ' ||l_dtbl(i).col_type);
when l_dtbl(i).col_type = 112 then --clob
if (include_clobs) then
dbms_sql.column_value(l_cur, i, read_clob);
data_list.append(pljson_string(read_clob));
end if;
when l_dtbl(i).col_type = 113 then --blob
if (include_blobs) then
dbms_sql.column_value(l_cur, i, read_blob);
if (dbms_lob.getlength(read_blob) > 0) then
data_list.append(pljson_ext.encode(read_blob));
else
data_list.append(pljson_null());
end if;
end if;
else null; --discard other types
end case;
end loop;
inner_list_data.append(data_list);
end loop;
outer_obj.put('names', inner_list_names);
outer_obj.put('data', inner_list_data);
dbms_sql.close_cursor(l_cur);
return outer_obj;
end executeObject;
end pljson_dyn;```

1105
docs/packages/PLJSON_EXT.md Normal file
View File

File diff suppressed because it is too large Load Diff

475
docs/packages/PLJSON_HELPER.md Normal file
View File

@@ -0,0 +1,475 @@
# PLJSON_HELPER
## Package Specification
```sql
package pljson_helper as
/* Example:
set serveroutput on;
declare
v_a json;
v_b json;
begin
v_a := json('{a:1, b:{a:null}, e:false}');
v_b := json('{c:3, e:{}, b:{b:2}}');
json_helper.merge(v_a, v_b).print(false);
end;
--
{"a":1,"b":{"a":null,"b":2},"e":{},"c":3}
*/
-- Recursive merge
-- Courtesy of Matt Nolan - edited by Jonas Krogsboell
function merge(p_a_json pljson, p_b_json pljson) return pljson;
-- Join two lists
-- json_helper.join(json_list('[1,2,3]'),json_list('[4,5,6]')) -> [1,2,3,4,5,6]
function join(p_a_list pljson_list, p_b_list pljson_list) return pljson_list;
-- keep only specific keys in json object
-- json_helper.keep(json('{a:1,b:2,c:3,d:4,e:5,f:6}'),json_list('["a","f","c"]')) -> {"a":1,"f":6,"c":3}
function keep(p_json pljson, p_keys pljson_list) return pljson;
-- remove specific keys in json object
-- json_helper.remove(json('{a:1,b:2,c:3,d:4,e:5,f:6}'),json_list('["a","f","c"]')) -> {"b":2,"d":4,"e":5}
function remove(p_json pljson, p_keys pljson_list) return pljson;
--equals
function equals(p_v1 pljson_element, p_v2 pljson_element, exact boolean default true) return boolean;
function equals(p_v1 pljson_element, p_v2 pljson, exact boolean default true) return boolean;
function equals(p_v1 pljson_element, p_v2 pljson_list, exact boolean default true) return boolean;
function equals(p_v1 pljson_element, p_v2 number) return boolean;
/* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */
function equals(p_v1 pljson_element, p_v2 binary_double) return boolean;
function equals(p_v1 pljson_element, p_v2 varchar2) return boolean;
function equals(p_v1 pljson_element, p_v2 boolean) return boolean;
function equals(p_v1 pljson_element, p_v2 clob) return boolean;
function equals(p_v1 pljson, p_v2 pljson, exact boolean default true) return boolean;
function equals(p_v1 pljson_list, p_v2 pljson_list, exact boolean default true) return boolean;
--contains json, json_value
--contains json_list, json_value
function contains(p_v1 pljson, p_v2 pljson_element, exact boolean default false) return boolean;
function contains(p_v1 pljson, p_v2 pljson, exact boolean default false) return boolean;
function contains(p_v1 pljson, p_v2 pljson_list, exact boolean default false) return boolean;
function contains(p_v1 pljson, p_v2 number, exact boolean default false) return boolean;
/* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */
function contains(p_v1 pljson, p_v2 binary_double, exact boolean default false) return boolean;
function contains(p_v1 pljson, p_v2 varchar2, exact boolean default false) return boolean;
function contains(p_v1 pljson, p_v2 boolean, exact boolean default false) return boolean;
function contains(p_v1 pljson, p_v2 clob, exact boolean default false) return boolean;
function contains(p_v1 pljson_list, p_v2 pljson_element, exact boolean default false) return boolean;
function contains(p_v1 pljson_list, p_v2 pljson, exact boolean default false) return boolean;
function contains(p_v1 pljson_list, p_v2 pljson_list, exact boolean default false) return boolean;
function contains(p_v1 pljson_list, p_v2 number, exact boolean default false) return boolean;
/* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */
function contains(p_v1 pljson_list, p_v2 binary_double, exact boolean default false) return boolean;
function contains(p_v1 pljson_list, p_v2 varchar2, exact boolean default false) return boolean;
function contains(p_v1 pljson_list, p_v2 boolean, exact boolean default false) return boolean;
function contains(p_v1 pljson_list, p_v2 clob, exact boolean default false) return boolean;
end pljson_helper;```
## Package Body
```sql
package body pljson_helper as
--recursive merge
function merge(p_a_json pljson, p_b_json pljson) return pljson as
l_json pljson;
l_jv pljson_element;
l_indx number;
l_recursive pljson_element;
begin
--
-- Initialize our return object
--
l_json := p_a_json;
-- loop through p_b_json
l_indx := p_b_json.json_data.first;
loop
exit when l_indx is null;
l_jv := p_b_json.json_data(l_indx);
if (l_jv.is_object) then
--recursive
l_recursive := l_json.get(l_jv.mapname);
if (l_recursive is not null and l_recursive.is_object) then
l_json.put(l_jv.mapname, merge(pljson(l_recursive), pljson(l_jv)));
else
l_json.put(l_jv.mapname, l_jv);
end if;
else
l_json.put(l_jv.mapname, l_jv);
end if;
--increment
l_indx := p_b_json.json_data.next(l_indx);
end loop;
return l_json;
end merge;
-- join two lists
function join(p_a_list pljson_list, p_b_list pljson_list) return pljson_list as
l_json_list pljson_list := p_a_list;
begin
for indx in 1 .. p_b_list.count loop
l_json_list.append(p_b_list.get(indx));
end loop;
return l_json_list;
end join;
-- keep keys.
function keep(p_json pljson, p_keys pljson_list) return pljson as
l_json pljson := pljson();
mapname varchar2(4000);
begin
for i in 1 .. p_keys.count loop
mapname := p_keys.get(i).get_string();
if (p_json.exist(mapname)) then
l_json.put(mapname, p_json.get(mapname));
end if;
end loop;
return l_json;
end keep;
-- drop keys.
function remove(p_json pljson, p_keys pljson_list) return pljson as
l_json pljson := p_json;
begin
for i in 1 .. p_keys.count loop
l_json.remove(p_keys.get(i).get_string());
end loop;
return l_json;
end remove;
--equals functions
function equals(p_v1 pljson_element, p_v2 number) return boolean as
begin
if (p_v2 is null) then
return p_v1.is_null;
end if;
if (not p_v1.is_number) then
return false;
end if;
return p_v2 = p_v1.get_number();
end;
/* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */
function equals(p_v1 pljson_element, p_v2 binary_double) return boolean as
begin
if (p_v2 is null) then
return p_v1.is_null;
end if;
if (not p_v1.is_number) then
return false;
end if;
return p_v2 = p_v1.get_double();
end;
function equals(p_v1 pljson_element, p_v2 boolean) return boolean as
begin
if (p_v2 is null) then
return p_v1.is_null;
end if;
if (not p_v1.is_bool) then
return false;
end if;
return p_v2 = p_v1.get_bool();
end;
function equals(p_v1 pljson_element, p_v2 varchar2) return boolean as
begin
if (p_v2 is null) then
return (p_v1.is_null or p_v1.get_string() is null);
end if;
if (not p_v1.is_string) then
return false;
end if;
return p_v2 = p_v1.get_string();
end;
function equals(p_v1 pljson_element, p_v2 clob) return boolean as
my_clob clob;
res boolean;
begin
if (p_v2 is null) then
return p_v1.is_null;
end if;
if (not p_v1.is_string) then
return false;
end if;
/*
my_clob := empty_clob();
dbms_lob.createtemporary(my_clob, true);
p_v1.get_string(my_clob);
*/
my_clob := p_v1.get_clob();
res := dbms_lob.compare(p_v2, my_clob) = 0;
/*dbms_lob.freetemporary(my_clob);*/
return res;
end;
function equals(p_v1 pljson_element, p_v2 pljson_element, exact boolean) return boolean as
begin
if (p_v2 is null or p_v2.is_null) then
return (p_v1 is null or p_v1.is_null);
end if;
if (p_v2.is_number) then return equals(p_v1, p_v2.get_number); end if;
if (p_v2.is_bool) then return equals(p_v1, p_v2.get_bool); end if;
if (p_v2.is_object) then return equals(p_v1, pljson(p_v2), exact); end if;
if (p_v2.is_array) then return equals(p_v1, pljson_list(p_v2), exact); end if;
if (p_v2.is_string) then
if (treat(p_v2 as pljson_string).extended_str is null) then
return equals(p_v1, p_v2.get_string);
else
declare
my_clob clob; res boolean;
begin
/*
my_clob := empty_clob();
dbms_lob.createtemporary(my_clob, true);
p_v2.get_string(my_clob);
*/
my_clob := p_v2.get_clob();
res := equals(p_v1, my_clob);
/*dbms_lob.freetemporary(my_clob);*/
return res;
end;
end if;
end if;
return false; --should never happen
end;
function equals(p_v1 pljson_element, p_v2 pljson_list, exact boolean) return boolean as
cmp pljson_list;
res boolean := true;
begin
-- p_v1.print(false);
-- p_v2.print(false);
-- dbms_output.put_line('labc1'||case when exact then 'X' else 'U' end);
if (p_v2 is null) then
return p_v1.is_null;
end if;
if (not p_v1.is_array) then
return false;
end if;
-- dbms_output.put_line('labc2'||case when exact then 'X' else 'U' end);
cmp := pljson_list(p_v1);
if (cmp.count != p_v2.count and exact) then return false; end if;
-- dbms_output.put_line('labc3'||case when exact then 'X' else 'U' end);
if (exact) then
for i in 1 .. cmp.count loop
res := equals(cmp.get(i), p_v2.get(i), exact);
if (not res) then return res; end if;
end loop;
else
-- dbms_output.put_line('labc4'||case when exact then 'X' else 'U' end);
if (p_v2.count > cmp.count) then return false; end if;
-- dbms_output.put_line('labc5'||case when exact then 'X' else 'U' end);
--match sublist here!
for x in 0 .. (cmp.count-p_v2.count) loop
-- dbms_output.put_line('labc7'||x);
for i in 1 .. p_v2.count loop
res := equals(cmp.get(x+i), p_v2.get(i), exact);
if (not res) then
goto next_index;
end if;
end loop;
return true;
<<next_index>>
null;
end loop;
-- dbms_output.put_line('labc7'||case when exact then 'X' else 'U' end);
return false; --no match
end if;
return res;
end;
function equals(p_v1 pljson_element, p_v2 pljson, exact boolean) return boolean as
cmp pljson;
res boolean := true;
begin
-- p_v1.print(false);
-- p_v2.print(false);
-- dbms_output.put_line('abc1');
if (p_v2 is null) then
return p_v1.is_null;
end if;
if (not p_v1.is_object) then
return false;
end if;
cmp := pljson(p_v1);
-- dbms_output.put_line('abc2');
if (cmp.count != p_v2.count and exact) then return false; end if;
-- dbms_output.put_line('abc3');
declare
k1 pljson_list := p_v2.get_keys();
key_index number;
begin
for i in 1 .. k1.count loop
key_index := cmp.index_of(k1.get(i).get_string());
if (key_index = -1) then return false; end if;
if (exact) then
if (not equals(p_v2.get(i), cmp.get(key_index), true)) then return false; end if;
else
--non exact
declare
v1 pljson_element := cmp.get(key_index);
v2 pljson_element := p_v2.get(i);
begin
-- dbms_output.put_line('abc3 1/2');
-- v1.print(false);
-- v2.print(false);
if (v1.is_object and v2.is_object) then
if (not equals(v1, v2, false)) then return false; end if;
elsif (v1.is_array and v2.is_array) then
if (not equals(v1, v2, false)) then return false; end if;
else
if (not equals(v1, v2, true)) then return false; end if;
end if;
end;
end if;
end loop;
end;
-- dbms_output.put_line('abc4');
return true;
end;
function equals(p_v1 pljson, p_v2 pljson, exact boolean) return boolean as
begin
return equals(p_v1, p_v2, exact);
end;
function equals(p_v1 pljson_list, p_v2 pljson_list, exact boolean) return boolean as
begin
return equals(p_v1, p_v2, exact);
end;
--contain
function contains(p_v1 pljson, p_v2 pljson_element, exact boolean) return boolean as
v_values pljson_list;
begin
if (equals(p_v1, p_v2, exact)) then return true; end if;
v_values := p_v1.get_values();
for i in 1 .. v_values.count loop
declare
v_val pljson_element := v_values.get(i);
begin
if (v_val.is_object) then
if (contains(pljson(v_val), p_v2, exact)) then return true; end if;
end if;
if (v_val.is_array) then
if (contains(pljson_list(v_val), p_v2, exact)) then return true; end if;
end if;
if (equals(v_val, p_v2, exact)) then return true; end if;
end;
end loop;
return false;
end;
function contains(p_v1 pljson_list, p_v2 pljson_element, exact boolean) return boolean as
begin
if (equals(p_v1, p_v2, exact)) then return true; end if;
for i in 1 .. p_v1.count loop
declare
v_val pljson_element := p_v1.get(i);
begin
if (v_val.is_object) then
if (contains(pljson(v_val), p_v2, exact)) then return true; end if;
end if;
if (v_val.is_array) then
if (contains(pljson_list(v_val), p_v2, exact)) then return true; end if;
end if;
if (equals(v_val, p_v2, exact)) then return true; end if;
end;
end loop;
return false;
end;
function contains(p_v1 pljson, p_v2 pljson, exact boolean ) return boolean as
begin return contains(p_v1, p_v2, exact); end;
function contains(p_v1 pljson, p_v2 pljson_list, exact boolean ) return boolean as
begin return contains(p_v1, p_v2, exact); end;
function contains(p_v1 pljson, p_v2 number, exact boolean ) return boolean as begin
return contains(p_v1, pljson_number(p_v2), exact); end;
/* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */
function contains(p_v1 pljson, p_v2 binary_double, exact boolean ) return boolean as begin
return contains(p_v1, pljson_number(p_v2), exact); end;
function contains(p_v1 pljson, p_v2 varchar2, exact boolean ) return boolean as begin
return contains(p_v1, pljson_string(p_v2), exact); end;
function contains(p_v1 pljson, p_v2 boolean, exact boolean ) return boolean as begin
return contains(p_v1, pljson_bool(p_v2), exact); end;
function contains(p_v1 pljson, p_v2 clob, exact boolean ) return boolean as begin
return contains(p_v1, pljson_string(p_v2), exact); end;
function contains(p_v1 pljson_list, p_v2 pljson, exact boolean ) return boolean as begin
return contains(p_v1, p_v2, exact); end;
function contains(p_v1 pljson_list, p_v2 pljson_list, exact boolean ) return boolean as begin
return contains(p_v1, p_v2, exact); end;
function contains(p_v1 pljson_list, p_v2 number, exact boolean ) return boolean as begin
return contains(p_v1, pljson_number(p_v2), exact); end;
/* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */
function contains(p_v1 pljson_list, p_v2 binary_double, exact boolean ) return boolean as begin
return contains(p_v1, pljson_number(p_v2), exact); end;
function contains(p_v1 pljson_list, p_v2 varchar2, exact boolean ) return boolean as begin
return contains(p_v1, pljson_string(p_v2), exact); end;
function contains(p_v1 pljson_list, p_v2 boolean, exact boolean ) return boolean as begin
return contains(p_v1, pljson_bool(p_v2), exact); end;
function contains(p_v1 pljson_list, p_v2 clob, exact boolean ) return boolean as begin
return contains(p_v1, pljson_string(p_v2), exact); end;
end pljson_helper;```

310
docs/packages/PLJSON_ML.md Normal file
View File

@@ -0,0 +1,310 @@
# PLJSON_ML
## Package Specification
```sql
package pljson_ml 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.
*/
/* This package contains extra methods to lookup types and
an easy way of adding date values in json - without changing the structure */
jsonml_stylesheet xmltype := null;
function xml2json(xml in xmltype) return pljson_list;
function xmlstr2json(xmlstr in varchar2) return pljson_list;
end pljson_ml;```
## Package Body
```sql
package body pljson_ml as
function get_jsonml_stylesheet return xmltype;
function xml2json(xml in xmltype) return pljson_list as
l_json xmltype;
l_returnvalue clob;
begin
l_json := xml.transform (get_jsonml_stylesheet);
l_returnvalue := l_json.getclobval();
l_returnvalue := dbms_xmlgen.convert (l_returnvalue, dbms_xmlgen.entity_decode);
--dbms_output.put_line(l_returnvalue);
return pljson_list(l_returnvalue);
end xml2json;
function xmlstr2json(xmlstr in varchar2) return pljson_list as
begin
return xml2json(xmltype(xmlstr));
end xmlstr2json;
function get_jsonml_stylesheet return xmltype as
begin
if (jsonml_stylesheet is null) then
jsonml_stylesheet := xmltype('<?xml version="1.0" encoding="UTF-8"?>
<!--
JsonML.xslt
Created: 2006-11-15-0551
Modified: 2009-02-14-0927
Released under an open-source license:
http://jsonml.org/License.htm
This transformation converts any XML document into JsonML.
It omits processing-instructions and comment-nodes.
To enable comment-nodes to be emitted as JavaScript comments,
uncomment the Comment() template.
-->
<xsl:stylesheet version="1.0"
xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
<xsl:output method="text"
media-type="application/json"
encoding="UTF-8"
indent="no"
omit-xml-declaration="yes" />
<!-- constants -->
<xsl:variable name="XHTML"
select="''http://www.w3.org/1999/xhtml''" />
<xsl:variable name="START_ELEM"
select="''[''" />
<xsl:variable name="END_ELEM"
select="'']''" />
<xsl:variable name="VALUE_DELIM"
select="'',''" />
<xsl:variable name="START_ATTRIB"
select="''{''" />
<xsl:variable name="END_ATTRIB"
select="''}''" />
<xsl:variable name="NAME_DELIM"
select="'':''" />
<xsl:variable name="STRING_DELIM"
select="''&#x22;''" />
<xsl:variable name="START_COMMENT"
select="''/*''" />
<xsl:variable name="END_COMMENT"
select="''*/''" />
<!-- root-node -->
<xsl:template match="/">
<xsl:apply-templates select="*" />
</xsl:template>
<!-- comments -->
<xsl:template match="comment()">
<!-- uncomment to support JSON comments -->
<!--
<xsl:value-of select="$START_COMMENT" />
<xsl:value-of select="."
disable-output-escaping="yes" />
<xsl:value-of select="$END_COMMENT" />
-->
</xsl:template>
<!-- elements -->
<xsl:template match="*">
<xsl:value-of select="$START_ELEM" />
<!-- tag-name string -->
<xsl:value-of select="$STRING_DELIM" />
<xsl:choose>
<xsl:when test="namespace-uri()=$XHTML">
<xsl:value-of select="local-name()" />
</xsl:when>
<xsl:otherwise>
<xsl:value-of select="name()" />
</xsl:otherwise>
</xsl:choose>
<xsl:value-of select="$STRING_DELIM" />
<!-- attribute object -->
<xsl:if test="count(@*)>0">
<xsl:value-of select="$VALUE_DELIM" />
<xsl:value-of select="$START_ATTRIB" />
<xsl:for-each select="@*">
<xsl:if test="position()>1">
<xsl:value-of select="$VALUE_DELIM" />
</xsl:if>
<xsl:apply-templates select="." />
</xsl:for-each>
<xsl:value-of select="$END_ATTRIB" />
</xsl:if>
<!-- child elements and text-nodes -->
<xsl:for-each select="*|text()">
<xsl:value-of select="$VALUE_DELIM" />
<xsl:apply-templates select="." />
</xsl:for-each>
<xsl:value-of select="$END_ELEM" />
</xsl:template>
<!-- text-nodes -->
<xsl:template match="text()">
<xsl:call-template name="escape-string">
<xsl:with-param name="value"
select="." />
</xsl:call-template>
</xsl:template>
<!-- attributes -->
<xsl:template match="@*">
<xsl:value-of select="$STRING_DELIM" />
<xsl:choose>
<xsl:when test="namespace-uri()=$XHTML">
<xsl:value-of select="local-name()" />
</xsl:when>
<xsl:otherwise>
<xsl:value-of select="name()" />
</xsl:otherwise>
</xsl:choose>
<xsl:value-of select="$STRING_DELIM" />
<xsl:value-of select="$NAME_DELIM" />
<xsl:call-template name="escape-string">
<xsl:with-param name="value"
select="." />
</xsl:call-template>
</xsl:template>
<!-- escape-string: quotes and escapes -->
<xsl:template name="escape-string">
<xsl:param name="value" />
<xsl:value-of select="$STRING_DELIM" />
<xsl:if test="string-length($value)>0">
<xsl:variable name="escaped-whacks">
<!-- escape backslashes -->
<xsl:call-template name="string-replace">
<xsl:with-param name="value"
select="$value" />
<xsl:with-param name="find"
select="''\''" />
<xsl:with-param name="replace"
select="''\\''" />
</xsl:call-template>
</xsl:variable>
<xsl:variable name="escaped-LF">
<!-- escape line feeds -->
<xsl:call-template name="string-replace">
<xsl:with-param name="value"
select="$escaped-whacks" />
<xsl:with-param name="find"
select="''&#x0A;''" />
<xsl:with-param name="replace"
select="''\n''" />
</xsl:call-template>
</xsl:variable>
<xsl:variable name="escaped-CR">
<!-- escape carriage returns -->
<xsl:call-template name="string-replace">
<xsl:with-param name="value"
select="$escaped-LF" />
<xsl:with-param name="find"
select="''&#x0D;''" />
<xsl:with-param name="replace"
select="''\r''" />
</xsl:call-template>
</xsl:variable>
<xsl:variable name="escaped-tabs">
<!-- escape tabs -->
<xsl:call-template name="string-replace">
<xsl:with-param name="value"
select="$escaped-CR" />
<xsl:with-param name="find"
select="''&#x09;''" />
<xsl:with-param name="replace"
select="''\t''" />
</xsl:call-template>
</xsl:variable>
<!-- escape quotes -->
<xsl:call-template name="string-replace">
<xsl:with-param name="value"
select="$escaped-tabs" />
<xsl:with-param name="find"
select="''&quot;''" />
<xsl:with-param name="replace"
select="''\&quot;''" />
</xsl:call-template>
</xsl:if>
<xsl:value-of select="$STRING_DELIM" />
</xsl:template>
<!-- string-replace: replaces occurances of one string with another -->
<xsl:template name="string-replace">
<xsl:param name="value" />
<xsl:param name="find" />
<xsl:param name="replace" />
<xsl:choose>
<xsl:when test="contains($value,$find)">
<!-- replace and call recursively on next -->
<xsl:value-of select="substring-before($value,$find)"
disable-output-escaping="yes" />
<xsl:value-of select="$replace"
disable-output-escaping="yes" />
<xsl:call-template name="string-replace">
<xsl:with-param name="value"
select="substring-after($value,$find)" />
<xsl:with-param name="find"
select="$find" />
<xsl:with-param name="replace"
select="$replace" />
</xsl:call-template>
</xsl:when>
<xsl:otherwise>
<!-- no replacement necessary -->
<xsl:value-of select="$value"
disable-output-escaping="yes" />
</xsl:otherwise>
</xsl:choose>
</xsl:template>
</xsl:stylesheet>');
end if;
return jsonml_stylesheet;
end get_jsonml_stylesheet;
end pljson_ml;```

171
docs/packages/PLJSON_OBJECT_CACHE.md Normal file
View File

@@ -0,0 +1,171 @@
# PLJSON_OBJECT_CACHE
## Package Specification
```sql
package pljson_object_cache as
/* E.I.Sarmas (github.com/dsnz) 2020-04-18 object cache to speed up internal operations */
/* !!! NOTE: this package is used internally by pljson and it's not part of the api !!! */
/* index by string of "id.path" or "path" */
type pljson_element_tab is table of pljson_element index by varchar2(250);
last_id number := 0;
pljson_element_cache pljson_element_tab;
cache_reqs number := 0;
cache_hits number := 0;
cache_invalid_reqs number := 0;
type vset is table of varchar2(1) index by varchar2(250);
names_set vset;
procedure set_names_set(names pljson_varray);
function in_names_set(a_name varchar2) return boolean;
procedure reset;
procedure flush;
procedure print_stats;
function next_id return number;
function object_key(elem pljson_element, piece varchar2) return varchar2;
function get(key varchar2) return pljson_element;
procedure set(key varchar2, val pljson_element);
end;```
## Package Body
```sql
package body pljson_object_cache as
/* E.I.Sarmas (github.com/dsnz) 2020-04-18 object cache to speed up internal operations */
/* !!! NOTE: this package is used internally by pljson and it's not part of the api !!! */
procedure set_names_set(names pljson_varray) is
begin
if names.COUNT = 0 then
return;
end if;
for i in names.FIRST .. names.LAST loop
names_set(names(i)) := '1';
end loop;
end;
function in_names_set(a_name varchar2) return boolean is
begin
if names_set.exists(a_name) then
return true;
else
return false;
end if;
end;
procedure reset is
begin
last_id := 0;
flush;
end;
procedure flush is
begin
pljson_element_cache.delete;
cache_reqs := 0;
cache_hits := 0;
cache_invalid_reqs := 0;
end;
procedure print_stats is
begin
dbms_output.put_line('reqs = ' || cache_reqs);
dbms_output.put_line('hits = ' || cache_hits);
dbms_output.put_line('invalid reqs = ' || cache_invalid_reqs);
dbms_output.put_line('cache count = ' || pljson_element_cache.count);
dbms_output.put_line('id count = ' || last_id);
end;
function next_id return number is
begin
last_id := last_id + 1;
return last_id;
end;
function object_key(elem pljson_element, piece varchar2) return varchar2 is
key varchar2(250);
begin
if elem.object_id is null or elem.object_id = 0 then
cache_invalid_reqs := cache_invalid_reqs + 1;
return null;
end if;
key := to_char(elem.object_id)||'.'||piece;
return key;
end;
function get(key varchar2) return pljson_element is
cache_key varchar2(32767);
begin
cache_key := key;
if cache_key is null then
cache_key := '$';
end if;
cache_reqs := cache_reqs + 1;
if pljson_element_cache.exists(cache_key) then
cache_hits := cache_hits + 1;
return pljson_element_cache(cache_key);
else
return null;
end if;
end;
procedure set(key varchar2, val pljson_element) is
cache_key varchar2(32767);
begin
cache_key := key;
if cache_key is null then
cache_key := '$';
end if;
--dbms_output.put_line('caching: ' || cache_key);
pljson_element_cache(cache_key) := val;
end;
/*
-- experimental, ignore
-- to use with 'get_json_element'
function get_piece(elem pljson, piece varchar2) return pljson_element is
key varchar2(250);
val pljson_element;
begin
key := object_cache.object_key(elem, piece);
if key is null then
return elem.get(piece);
end if;
val := object_cache.get(key);
if val is not null then
return val;
else
val := elem.get(piece);
object_cache.set(key, val);
return val;
end if;
end;
function get_piece(elem pljson_list, piece varchar2) return pljson_element is
key varchar2(250);
val pljson_element;
begin
key := object_cache.object_key(elem, piece);
if key is null then
return elem.get(piece);
end if;
val := object_cache.get(key);
if val is not null then
return val;
else
val := elem.get(piece);
object_cache.set(key, val);
return val;
end if;
end;
*/
end;```

986
docs/packages/PLJSON_PARSER.md Normal file
View File

@@ -0,0 +1,986 @@
# PLJSON_PARSER
## Package Specification
```sql
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);
json_strict boolean not null := false;
ucs2_exception EXCEPTION;
pragma exception_init(ucs2_exception, -22831);
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;```
## Package Body
```sql
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) := '.';
/* moved to package spec
ucs2_exception EXCEPTION;
pragma exception_init(ucs2_exception, -22831);
*/
function lengthcc(buf clob) return number as
offset number := 0;
len number := 0;
src varchar2(32767);
src_len number;
begin
while true loop
begin
src := dbms_lob.substr(buf, 4000, offset+1);
exception
when ucs2_exception then
src := dbms_lob.substr(buf, 3999, 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 > length(s.src) + 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, 4000, s.offset+1);
exception
when ucs2_exception then
s.src := dbms_lob.substr(s.s_clob, 3999, s.offset+1);
end;
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, 4000, s.offset+1);
exception
when ucs2_exception then
s.src := dbms_lob.substr(s.s_clob, 3999, s.offset+1);
end;
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, 4000, s.offset+1);
exception
when ucs2_exception then
s.src := dbms_lob.substr(s.s_clob, 3999, s.offset+1);
end;
end loop;
end if;
--dbms_output.put_line('indx: ' || indx || ' offset: ' || s.offset || ' (chars: ' || s.offset_chars || ') src chars: ' || length(s.src));
--read from s.src
return substr(s.src, indx-s.offset_chars, 1);
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, 4000, temp.offset+1);
exception
when ucs2_exception then
temp.src := dbms_lob.substr(buf, 3999, 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);
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, 4000);
temp.len := length(buf);
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 3.5.2';
end get_version;
end pljson_parser;```

727
docs/packages/PLJSON_PRINTER.md Normal file
View File

@@ -0,0 +1,727 @@
# PLJSON_PRINTER
## Package Specification
```sql
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;
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;```
## Package Body
```sql
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 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 method start here */
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, case when elem.num = 1 then '"' else '/**/' end);
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, case when elem.num = 1 then '"' else '/**/' end);
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);
return;
/* object */
when 1 then
pretty_print(pljson(json_part), spaces, buf, line_length);
return;
else
add_to_clob(buf, buf_str, 'unknown type:' || json_part.get_type);
end case;
flush_clob(buf, buf_str);
end;
/* Clob method end here */
/* Varchar2 method start here */
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, case when elem.num = 1 then '"' else '/**/' end);
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, case when elem.num = 1 then '"' else '/**/' end);
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;
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;```

204
docs/packages/PLJSON_UT.md Normal file
View File

@@ -0,0 +1,204 @@
# PLJSON_UT
## Package Specification
```sql
package pljson_ut as
/*
*
* E.I.Sarmas (github.com/dsnz) 2017-07-22
*
* Simple unit test framework for pljson
*
*/
suite_id number;
suite_name varchar2(100);
file_name varchar2(100);
pass_count number;
fail_count number;
total_count number;
case_name varchar2(100);
case_pass number;
case_fail number;
case_total number;
INDENT_1 varchar2(10) := ' ';
INDENT_2 varchar2(10) := ' ';
procedure testsuite(suite_name_ varchar2, file_name_ varchar2);
procedure testcase(case_name_ varchar2);
procedure pass(test_name varchar2 := null);
procedure fail(test_name varchar2 := null);
procedure assertTrue(b boolean, test_name varchar2 := null);
procedure assertFalse(b boolean, test_name varchar2 := null);
procedure testsuite_report;
procedure startup;
procedure shutdown;
end pljson_ut;```
## Package Body
```sql
package body pljson_ut as
/*
*
* E.I.Sarmas (github.com/dsnz) 2017-07-22
*
* Simple unit test framework for pljson
*
*/
procedure testsuite(suite_name_ varchar2, file_name_ varchar2) is
begin
suite_id := suite_id + 1;
suite_name := suite_name_;
file_name := file_name_;
pass_count := 0;
fail_count := 0;
total_count := 0;
dbms_output.put_line(suite_name_);
end;
procedure testcase(case_name_ varchar2) is
begin
case_name := case_name_;
case_pass := 0;
case_fail := 0;
case_total := 0;
dbms_output.put_line(INDENT_1 || case_name_);
end;
procedure pass(test_name varchar2 := null) is
begin
if (case_total = 0) then
pass_count := pass_count + 1;
total_count := total_count + 1;
end if;
case_pass := case_pass + 1;
case_total := case_total + 1;
if (test_name is not null) then
dbms_output.put_line(INDENT_2 || 'OK: '|| test_name);
end if;
end;
procedure fail(test_name varchar2 := null) is
begin
if (case_fail = 0) then
fail_count := fail_count + 1;
if (case_total = 0) then
total_count := total_count + 1;
else
pass_count := pass_count - 1;
end if;
end if;
case_fail := case_fail + 1;
case_total := case_total + 1;
if (test_name is not null) then
dbms_output.put_line(INDENT_2 || 'FAILED: '|| test_name);
end if;
end;
procedure assertTrue(b boolean, test_name varchar2 := null) is
begin
if (b) then
pass(test_name);
else
fail(test_name);
end if;
end;
procedure assertFalse(b boolean, test_name varchar2 := null) is
begin
if (not b) then
pass(test_name);
else
fail(test_name);
end if;
end;
procedure testsuite_report is
begin
dbms_output.put_line('');
dbms_output.put_line(
total_count || ' tests, '
|| pass_count || ' passed, '
|| fail_count || ' failed'
);
execute immediate 'insert into pljson_testsuite values (:1, :2, :3, :4, :5, :6)'
using suite_id, suite_name, file_name, pass_count, fail_count, total_count;
end;
procedure startup is
begin
suite_id := 0;
execute immediate 'truncate table pljson_testsuite';
end;
procedure shutdown is
begin
commit;
dbms_output.put_line('');
for rec in (
select suite_id, suite_name, passed, failed, total, file_name
from (
select 3 s, suite_id,
lpad(suite_name, 30) suite_name,
to_char(passed, '999999') passed,
to_char(failed, '999999') failed,
to_char(total, '999999') total,
lpad(file_name, 30) file_name
from pljson_testsuite
union
select 1 s, 0 suite_id,
lpad('SUITE_NAME', 30) suite_name,
lpad('PASSED', 7) passed,
lpad('FAILED', 7) failed,
lpad('TOTAL', 7) total,
lpad('FILE_NAME', 30) file_name
from dual
union
select 5 s, 0,
lpad('ALL TESTS', 30) suite_name,
to_char(sum(passed), '999999') passed,
to_char(sum(failed), '999999') failed,
to_char(sum(total), '999999') total,
lpad(' ', 30) file_name
from pljson_testsuite
union
select 2 s, 0 suite_id,
lpad('-', 30, '-') suite_name,
lpad('-', 7, '-') passed,
lpad('-', 7, '-') failed,
lpad('-', 7, '-') total,
lpad('-', 30, '-') file_name
from dual
union
select 4 s, 0 suite_id,
lpad('-', 30, '-') suite_name,
lpad('-', 7, '-') passed,
lpad('-', 7, '-') failed,
lpad('-', 7, '-') total,
lpad('-', 30, '-') file_name
from dual
order by s, suite_id
)
)
loop
dbms_output.put_line(
rec.suite_name||' '||rec.passed||' '||rec.failed||' '||rec.total||' '||rec.file_name
);
end loop;
end;
end pljson_ut;```

370
docs/packages/PLJSON_UTIL_PKG.md Normal file
View File

@@ -0,0 +1,370 @@
# PLJSON_UTIL_PKG
## Package Specification
```sql
package pljson_util_pkg authid current_user as
/*
Purpose: JSON utilities for PL/SQL
see http://ora-00001.blogspot.com/
Remarks:
Who Date Description
------ ---------- -------------------------------------
MBR 30.01.2010 Created
JKR 01.05.2010 Edited to fit in PL/JSON
JKR 19.01.2011 Newest stylesheet + bugfix handling
*/
-- generate JSON from REF Cursor
function ref_cursor_to_json (p_ref_cursor in sys_refcursor,
p_max_rows in number := null,
p_skip_rows in number := null) return pljson_list;
-- generate JSON from SQL statement
function sql_to_json (p_sql in varchar2,
p_max_rows in number := null,
p_skip_rows in number := null) return pljson_list;
end pljson_util_pkg;```
## Package Body
```sql
package body pljson_util_pkg as
scanner_exception exception;
pragma exception_init(scanner_exception, -20100);
parser_exception exception;
pragma exception_init(parser_exception, -20101);
/*
Purpose: JSON utilities for PL/SQL
Remarks:
Who Date Description
------ ---------- -------------------------------------
MBR 30.01.2010 Created
*/
function get_xml_to_json_stylesheet return varchar2 as
stylesheet varchar2(32767);
nls_numeric_characters varchar2(2);
begin
/*
Purpose: return XSLT stylesheet for XML to JSON transformation
Remarks: see http://code.google.com/p/xml2json-xslt/
Who Date Description
------ ---------- -------------------------------------
MBR 30.01.2010 Created
MBR 30.01.2010 Added fix for nulls
*/
stylesheet := q'^<?xml version="1.0" encoding="UTF-8"?>
<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
<!--
Copyright (c) 2006,2008 Doeke Zanstra
All rights reserved.
Redistribution and use in source and binary forms, with or without modification,
are permitted provided that the following conditions are met:
Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer. Redistributions in binary
form must reproduce the above copyright notice, this list of conditions and the
following disclaimer in the documentation and/or other materials provided with
the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
THE POSSIBILITY OF SUCH DAMAGE.
-->
<xsl:output indent="no" omit-xml-declaration="yes" method="text" encoding="UTF-8" media-type="text/x-json"/>
<xsl:strip-space elements="*"/>
<!--contant-->
<xsl:variable name="d">0123456789</xsl:variable>
<!-- ignore document text -->
<xsl:template match="text()[preceding-sibling::node() or following-sibling::node()]"/>
<!-- string -->
<xsl:template match="text()">
<xsl:call-template name="escape-string">
<xsl:with-param name="s" select="."/>
</xsl:call-template>
</xsl:template>
<!-- Main template for escaping strings; used by above template and for object-properties
Responsibilities: placed quotes around string, and chain up to next filter, escape-bs-string -->
<xsl:template name="escape-string">
<xsl:param name="s"/>
<xsl:text>"</xsl:text>
<xsl:call-template name="escape-bs-string">
<xsl:with-param name="s" select="$s"/>
</xsl:call-template>
<xsl:text>"</xsl:text>
</xsl:template>
<!-- Escape the backslash (\) before everything else. -->
<xsl:template name="escape-bs-string">
<xsl:param name="s"/>
<xsl:choose>
<xsl:when test="contains($s,'\')">
<xsl:call-template name="escape-quot-string">
<xsl:with-param name="s" select="concat(substring-before($s,'\'),'\\')"/>
</xsl:call-template>
<xsl:call-template name="escape-bs-string">
<xsl:with-param name="s" select="substring-after($s,'\')"/>
</xsl:call-template>
</xsl:when>
<xsl:otherwise>
<xsl:call-template name="escape-quot-string">
<xsl:with-param name="s" select="$s"/>
</xsl:call-template>
</xsl:otherwise>
</xsl:choose>
</xsl:template>
<!-- Escape the double quote ("). -->
<xsl:template name="escape-quot-string">
<xsl:param name="s"/>
<xsl:choose>
<xsl:when test="contains($s,'&quot;')">
<xsl:call-template name="encode-string">
<xsl:with-param name="s" select="concat(substring-before($s,'&quot;'),'\&quot;')"/>
</xsl:call-template>
<xsl:call-template name="escape-quot-string">
<xsl:with-param name="s" select="substring-after($s,'&quot;')"/>
</xsl:call-template>
</xsl:when>
<xsl:otherwise>
<xsl:call-template name="encode-string">
<xsl:with-param name="s" select="$s"/>
</xsl:call-template>
</xsl:otherwise>
</xsl:choose>
</xsl:template>
<!-- Replace tab, line feed and/or carriage return by its matching escape code. Can't escape backslash
or double quote here, because they don't replace characters (&#x0; becomes \t), but they prefix
characters (\ becomes \\). Besides, backslash should be seperate anyway, because it should be
processed first. This function can't do that. -->
<xsl:template name="encode-string">
<xsl:param name="s"/>
<xsl:choose>
<!-- tab -->
<xsl:when test="contains($s,'&#x9;')">
<xsl:call-template name="encode-string">
<xsl:with-param name="s" select="concat(substring-before($s,'&#x9;'),'\t',substring-after($s,'&#x9;'))"/>
</xsl:call-template>
</xsl:when>
<!-- line feed -->
<xsl:when test="contains($s,'&#xA;')">
<xsl:call-template name="encode-string">
<xsl:with-param name="s" select="concat(substring-before($s,'&#xA;'),'\n',substring-after($s,'&#xA;'))"/>
</xsl:call-template>
</xsl:when>
<!-- carriage return -->
<xsl:when test="contains($s,'&#xD;')">
<xsl:call-template name="encode-string">
<xsl:with-param name="s" select="concat(substring-before($s,'&#xD;'),'\r',substring-after($s,'&#xD;'))"/>
</xsl:call-template>
</xsl:when>
<xsl:otherwise><xsl:value-of select="$s"/></xsl:otherwise>
</xsl:choose>
</xsl:template>
<!-- number (no support for javascript mantissa) -->
<xsl:template match="text()[not(
(starts-with(., '0' ) and . != '0' and not(starts-with(., '0.' ))) or
(starts-with(.,'-0' ) and . != '-0' and not(starts-with(.,'-0.' ))) or
string(number(translate(., '{{nls_numeric_characters}}', '.,')))='NaN'
)]">
<xsl:variable name="num_string" select="translate(., '{{nls_numeric_characters}}', '.,')"/>
<xsl:choose>
<xsl:when test="starts-with($num_string, '.')">
<xsl:value-of select="concat('0', $num_string)"/>
</xsl:when>
<xsl:otherwise>
<xsl:value-of select="$num_string"/>
</xsl:otherwise>
</xsl:choose>
</xsl:template>
<!-- boolean, case-insensitive -->
<xsl:template match="text()[translate(.,'TRUE','true')='true']">true</xsl:template>
<xsl:template match="text()[translate(.,'FALSE','false')='false']">false</xsl:template>
<!-- object -->
<xsl:template match="*" name="base">
<xsl:if test="not(preceding-sibling::*)">{</xsl:if>
<xsl:call-template name="escape-string">
<xsl:with-param name="s" select="name()"/>
</xsl:call-template>
<xsl:text>:</xsl:text>
<!-- check type of node -->
<xsl:choose>
<!-- null nodes -->
<xsl:when test="count(child::node())=0">null</xsl:when>
<!-- other nodes -->
<xsl:otherwise>
<xsl:apply-templates select="child::node()"/>
</xsl:otherwise>
</xsl:choose>
<!-- end of type check -->
<xsl:if test="following-sibling::*">,</xsl:if>
<xsl:if test="not(following-sibling::*)">}</xsl:if>
</xsl:template>
<!-- array -->
<xsl:template match="*[count(../*[name(../*)=name(.)])=count(../*) and count(../*)&gt;1]">
<xsl:if test="not(preceding-sibling::*)">[</xsl:if>
<xsl:choose>
<xsl:when test="not(child::node())">
<xsl:text>null</xsl:text>
</xsl:when>
<xsl:otherwise>
<xsl:apply-templates select="child::node()"/>
</xsl:otherwise>
</xsl:choose>
<xsl:if test="following-sibling::*">,</xsl:if>
<xsl:if test="not(following-sibling::*)">]</xsl:if>
</xsl:template>
<!-- convert root element to an anonymous container -->
<xsl:template match="/">
<xsl:apply-templates select="node()"/>
</xsl:template>
</xsl:stylesheet>^';
select value
into nls_numeric_characters
from nls_session_parameters
where parameter = 'NLS_NUMERIC_CHARACTERS';
return replace(stylesheet, '{{nls_numeric_characters}}', nls_numeric_characters);
end get_xml_to_json_stylesheet;
function ref_cursor_to_json (p_ref_cursor in sys_refcursor,
p_max_rows in number := null,
p_skip_rows in number := null) return pljson_list
as
l_ctx dbms_xmlgen.ctxhandle;
l_num_rows pls_integer;
l_xml xmltype;
l_xsl xmltype := xmltype(get_xml_to_json_stylesheet);
l_returnvalue clob;
begin
/*
Purpose: generate JSON from REF Cursor
Remarks:
Who Date Description
------ ---------- -------------------------------------
MBR 30.01.2010 Created
JKR 01.05.2010 Edited to fit in PL/JSON
*/
l_ctx := dbms_xmlgen.newcontext (p_ref_cursor);
dbms_xmlgen.setnullhandling (l_ctx, dbms_xmlgen.empty_tag);
-- for pagination
if p_max_rows is not null then
dbms_xmlgen.setmaxrows (l_ctx, p_max_rows);
end if;
if p_skip_rows is not null then
dbms_xmlgen.setskiprows (l_ctx, p_skip_rows);
end if;
-- get the XML content
l_xml := dbms_xmlgen.getxmltype (l_ctx, dbms_xmlgen.none);
l_num_rows := dbms_xmlgen.getnumrowsprocessed (l_ctx);
dbms_xmlgen.closecontext (l_ctx);
close p_ref_cursor;
if(l_num_rows = 0) then
return pljson_list();
end if;
--dbms_output.put_line(l_xml.getstringval);
-- perform the XSL transformation
SELECT l_xml.transform(l_xsl).getclobval()
INTO l_returnvalue
FROM DUAL;
--dbms_output.put_line(l_returnvalue);
if(l_num_rows > 1) then
return pljson_list(pljson(l_returnvalue).get('ROWSET'));
end if;
declare ret pljson_list := pljson_list();
begin
ret.append(
pljson(
pljson(l_returnvalue).get('ROWSET')
).get('ROW')
);
return ret;
end;
exception
when scanner_exception then
dbms_output.put('Scanner problem with the following input: ');
dbms_output.put_line(l_returnvalue);
raise;
when parser_exception then
dbms_output.put('Parser problem with the following input: ');
dbms_output.put_line(l_returnvalue);
raise;
when others then raise;
end ref_cursor_to_json;
function sql_to_json (p_sql in varchar2,
p_max_rows in number := null,
p_skip_rows in number := null) return pljson_list
as
v_cur sys_refcursor;
begin
open v_cur for p_sql;
return ref_cursor_to_json(v_cur, p_max_rows, p_skip_rows);
end sql_to_json;
end pljson_util_pkg;```

162
docs/packages/PLJSON_XML.md Normal file
View File

@@ -0,0 +1,162 @@
# PLJSON_XML
## Package Specification
```sql
package pljson_xml 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.
*/
/*
declare
obj json := json('{a:1, b:[2, 3, 4], c:true}');
x xmltype;
begin
obj.print;
x := json_xml.json_to_xml(obj);
dbms_output.put_line(x.getclobval());
end;
*/
function json_to_xml(obj pljson, tagname varchar2 default 'root') return xmltype;
end pljson_xml;```
## Package Body
```sql
package body pljson_xml as
function escapeStr(str varchar2) return varchar2 as
buf varchar2(32767) := '';
ch varchar2(4);
begin
for i in 1 .. length(str) loop
ch := substr(str, i, 1);
case ch
when '&' then buf := buf || '&amp;';
when '<' then buf := buf || '&lt;';
when '>' then buf := buf || '&gt;';
when '"' then buf := buf || '&quot;';
else buf := buf || ch;
end case;
end loop;
return buf;
end escapeStr;
/* Clob methods from printer */
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.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.append(buf_lob, buf_str);
end flush_clob;
procedure toString(obj pljson_element, tagname in varchar2, xmlstr in out nocopy clob, xmlbuf in out nocopy varchar2) as
v_obj pljson;
v_list pljson_list;
v_keys pljson_list;
v_value pljson_element;
key_str varchar2(4000);
begin
if (obj.is_object()) then
add_to_clob(xmlstr, xmlbuf, '<' || tagname || '>');
v_obj := pljson(obj);
v_keys := v_obj.get_keys();
for i in 1 .. v_keys.count loop
v_value := v_obj.get(i);
key_str := v_keys.get(i).get_string();
if (key_str = 'content') then
if (v_value.is_array()) then
declare
v_l pljson_list := pljson_list(v_value);
begin
for j in 1 .. v_l.count loop
if (j > 1) then add_to_clob(xmlstr, xmlbuf, chr(13)||chr(10)); end if;
add_to_clob(xmlstr, xmlbuf, escapeStr(v_l.get(j).to_char()));
end loop;
end;
else
add_to_clob(xmlstr, xmlbuf, escapeStr(v_value.to_char()));
end if;
elsif (v_value.is_array()) then
declare
v_l pljson_list := pljson_list(v_value);
begin
for j in 1 .. v_l.count loop
v_value := v_l.get(j);
if (v_value.is_array()) then
add_to_clob(xmlstr, xmlbuf, '<' || key_str || '>');
add_to_clob(xmlstr, xmlbuf, escapeStr(v_value.to_char()));
add_to_clob(xmlstr, xmlbuf, '</' || key_str || '>');
else
toString(v_value, key_str, xmlstr, xmlbuf);
end if;
end loop;
end;
elsif (v_value.is_null() or (v_value.is_string() and v_value.get_string() = '')) then
add_to_clob(xmlstr, xmlbuf, '<' || key_str || '/>');
else
toString(v_value, key_str, xmlstr, xmlbuf);
end if;
end loop;
add_to_clob(xmlstr, xmlbuf, '</' || tagname || '>');
elsif (obj.is_array()) then
v_list := pljson_list(obj);
for i in 1 .. v_list.count loop
v_value := v_list.get(i);
toString(v_value, nvl(tagname, 'array'), xmlstr, xmlbuf);
end loop;
else
add_to_clob(xmlstr, xmlbuf, '<' || tagname || '>'||case when obj.value_of() is not null then escapeStr(obj.value_of()) end ||'</' || tagname || '>');
end if;
end toString;
function json_to_xml(obj pljson, tagname varchar2 default 'root') return xmltype as
xmlstr clob := empty_clob();
xmlbuf varchar2(32767) := '';
returnValue xmltype;
begin
dbms_lob.createtemporary(xmlstr, true);
toString(obj, tagname, xmlstr, xmlbuf);
flush_clob(xmlstr, xmlbuf);
returnValue := xmltype('<?xml version="1.0"?>'||xmlstr);
dbms_lob.freetemporary(xmlstr);
return returnValue;
end;
end pljson_xml;```

102
docs/packages/README.md Normal file
View File

@@ -0,0 +1,102 @@
# Packages Database
Questa cartella contiene la documentazione di tutti i 17 packages del database.
## Packages Business
| Package | Descrizione |
|---------|-------------|
| [MAIL_PKG](MAIL_PKG.md) | Gestione invio email automatiche (solleciti, reminder) |
## Packages Utility
| Package | Descrizione |
|---------|-------------|
| [UTL_BASE64](UTL_BASE64.md) | Encoding/decoding Base64 |
## Packages JasperReports (XLIB)
| Package | Descrizione |
|---------|-------------|
| [XLIB_JASPERREPORTS](XLIB_JASPERREPORTS.md) | Integrazione con JasperReports server |
| [XLIB_JASPERREPORTS_IMG](XLIB_JASPERREPORTS_IMG.md) | Gestione immagini nei report |
| [XLIB_HTTP](XLIB_HTTP.md) | Chiamate HTTP/REST |
| [XLIB_COMPONENT](XLIB_COMPONENT.md) | Gestione componenti |
| [XLIB_LOG](XLIB_LOG.md) | Sistema di logging |
## Packages JSON (PLJSON Library)
Libreria esterna per parsing e generazione JSON. In .NET può essere sostituita con `System.Text.Json` o `Newtonsoft.Json`.
| Package | Descrizione |
|---------|-------------|
| [PLJSON_DYN](PLJSON_DYN.md) | Query dinamiche JSON |
| [PLJSON_EXT](PLJSON_EXT.md) | Estensioni JSON |
| [PLJSON_HELPER](PLJSON_HELPER.md) | Helper functions |
| [PLJSON_ML](PLJSON_ML.md) | Multi-line JSON |
| [PLJSON_OBJECT_CACHE](PLJSON_OBJECT_CACHE.md) | Cache oggetti JSON |
| [PLJSON_PARSER](PLJSON_PARSER.md) | Parser JSON |
| [PLJSON_PRINTER](PLJSON_PRINTER.md) | Output JSON formattato |
| [PLJSON_UT](PLJSON_UT.md) | Unit test JSON |
| [PLJSON_UTIL_PKG](PLJSON_UTIL_PKG.md) | Utility JSON |
| [PLJSON_XML](PLJSON_XML.md) | Conversione JSON ↔ XML |
## Dettaglio Package MAIL_PKG
### Procedures Disponibili
| Procedura | Descrizione |
|-----------|-------------|
| `send_custom_mail` | Invio email generica |
| `send_richiesta_riscontro_preventivo` | Sollecito per preventivi in stato 100/200 |
| `send_richiesta_riscontro_preventivo_job` | Job: 10 giorni dopo DATA_DOC |
| `send_richiesta_riscontro_post_degustazione` | Sollecito post-degustazione |
| `send_richiesta_riscontro_post_degustazione_job` | Job: 15 giorni dopo prima degustazione |
| `send_reminder_seconda_caparra` | Reminder pagamento seconda caparra |
| `send_reminder_seconda_caparra_job` | Job: ogni 5 giorni da 65gg prima evento |
### Configurazione Email
- **From**: `noreply@apollinarecatering.it`
- **BCC**: `monia@apollinarecatering.it, matrimonio@apollinarecatering.it`
- Usa `APEX_MAIL` per invio
- Richiede `CMN_MAIL_HTMLUTILS` per costruzione body HTML
### Migrazione .NET
```csharp
// Esempio implementazione con SendGrid o SMTP
public interface IMailService
{
Task SendCustomMailAsync(string recipients, string subject, string body);
Task SendRichiestaRiscontroPreventivo(int eventoId);
Task SendReminderSecondaCaparra(int eventoId);
}
// Jobs con Hangfire
[RecurringJob("0 9 * * *")]
public async Task SendReminderSecondaCaparraJob()
{
var eventi = await GetEventiDaPagareEntro65gg();
foreach (var evento in eventi.Where(e => ShouldSendReminder(e)))
{
await _mailService.SendReminderSecondaCaparra(evento.Id);
}
}
```
## Note per Migrazione
1. **MAIL_PKG**: Sostituire con servizio email .NET (SendGrid, SMTP, Azure Communication Services)
2. **PLJSON_***: Non necessari in .NET, usare `System.Text.Json`
3. **XLIB_JASPERREPORTS**: Valutare alternative:
- SSRS (SQL Server Reporting Services)
- DevExpress Reports
- Telerik Reporting
- QuestPDF / iTextSharp per PDF
4. **XLIB_HTTP**: Sostituire con `HttpClient`
5. **UTL_BASE64**: Usare `Convert.ToBase64String` / `Convert.FromBase64String`

168
docs/packages/UTL_BASE64.md Normal file
View File

@@ -0,0 +1,168 @@
# UTL_BASE64
## Package Specification
```sql
PACKAGE "UTL_BASE64" is
function decode_base64(p_clob_in in clob) return blob;
function encode_base64(p_blob_in in blob) return clob;
FUNCTION encodeBlob2Base64(pBlobIn IN BLOB) RETURN BLOB;
FUNCTION decodeBase642Blob(pBlobIn IN BLOB) RETURN BLOB;
function base64encode(p_blob in blob) return clob;
end;
```
## Package Body
```sql
PACKAGE BODY "UTL_BASE64" is
function decode_base64(p_clob_in in clob) return blob is
v_blob blob;
v_result blob;
v_offset integer;
v_buffer_size binary_integer := 48;
v_buffer_varchar varchar2(48);
v_buffer_raw raw(48);
begin
if p_clob_in is null then
return null;
end if;
dbms_lob.createtemporary(v_blob, true);
v_offset := 1;
for i in 1 .. ceil(dbms_lob.getlength(p_clob_in) / v_buffer_size) loop
dbms_lob.read(p_clob_in, v_buffer_size, v_offset, v_buffer_varchar);
v_buffer_raw := utl_raw.cast_to_raw(v_buffer_varchar);
v_buffer_raw := utl_encode.base64_decode(v_buffer_raw);
dbms_lob.writeappend(v_blob, utl_raw.length(v_buffer_raw), v_buffer_raw);
v_offset := v_offset + v_buffer_size;
end loop;
v_result := v_blob;
dbms_lob.freetemporary(v_blob);
return v_result;
end decode_base64;
function encode_base64(p_blob_in in blob) return clob is
v_clob clob;
v_result clob;
v_offset integer;
v_chunk_size binary_integer := (48 / 4) * 3;
v_buffer_varchar varchar2(48);
v_buffer_raw raw(48);
begin
if p_blob_in is null then
return null;
end if;
dbms_lob.createtemporary(v_clob, true);
v_offset := 1;
for i in 1 .. ceil(dbms_lob.getlength(p_blob_in) / v_chunk_size) loop
dbms_lob.read(p_blob_in, v_chunk_size, v_offset, v_buffer_raw);
v_buffer_raw := utl_encode.base64_encode(v_buffer_raw);
v_buffer_varchar := utl_raw.cast_to_varchar2(v_buffer_raw);
dbms_lob.writeappend(v_clob, length(v_buffer_varchar), v_buffer_varchar);
v_offset := v_offset + v_chunk_size;
end loop;
v_result := v_clob;
dbms_lob.freetemporary(v_clob);
return v_result;
end encode_base64;
FUNCTION encodeBlob2Base64(pBlobIn IN BLOB) RETURN BLOB IS
vAmount NUMBER := 45;
vBlobEnc BLOB := empty_blob();
vBlobEncLen NUMBER := 0;
vBlobInLen NUMBER := 0;
vBuffer RAW(45);
vOffset NUMBER := 1;
BEGIN
-- dbms_output.put_line('Start base64 encoding.');
vBlobInLen := dbms_lob.getlength(pBlobIn);
-- dbms_output.put_line('<BlobInLength>' || vBlobInLen);
dbms_lob.createtemporary(vBlobEnc, TRUE);
LOOP
IF vOffset >= vBlobInLen THEN
EXIT;
END IF;
dbms_lob.read(pBlobIn, vAmount, vOffset, vBuffer);
BEGIN
dbms_lob.append(vBlobEnc, utl_encode.base64_encode(vBuffer));
EXCEPTION
WHEN OTHERS THEN
dbms_output.put_line('<vAmount>' || vAmount || '<vOffset>' || vOffset || '<vBuffer>' || vBuffer);
dbms_output.put_line('ERROR IN append: ' || SQLERRM);
RAISE;
END;
vOffset := vOffset + vAmount;
END LOOP;
vBlobEncLen := dbms_lob.getlength(vBlobEnc);
-- dbms_output.put_line('<BlobEncLength>' || vBlobEncLen);
-- dbms_output.put_line('Finshed base64 encoding.');
RETURN vBlobEnc;
END encodeBlob2Base64;
FUNCTION decodeBase642Blob(pBlobIn IN BLOB) RETURN BLOB IS
vAmount NUMBER := 256;--32;
vBlobDec BLOB := empty_blob();
vBlobDecLen NUMBER := 0;
vBlobInLen NUMBER := 0;
vBuffer RAW(256);--32);
vOffset NUMBER := 1;
BEGIN
-- dbms_output.put_line('Start base64 decoding.');
vBlobInLen := dbms_lob.getlength(pBlobIn);
-- dbms_output.put_line('<BlobInLength>' || vBlobInLen);
dbms_lob.createtemporary(vBlobDec, TRUE);
LOOP
IF vOffset >= vBlobInLen THEN
EXIT;
END IF;
dbms_lob.read(pBlobIn, vAmount, vOffset, vBuffer);
BEGIN
dbms_lob.append(vBlobDec, utl_encode.base64_decode(vBuffer));
EXCEPTION
WHEN OTHERS THEN
dbms_output.put_line('<vAmount>' || vAmount || '<vOffset>' || vOffset || '<vBuffer>' || vBuffer);
dbms_output.put_line('ERROR IN append: ' || SQLERRM);
RAISE;
END;
vOffset := vOffset + vAmount;
END LOOP;
vBlobDecLen := dbms_lob.getlength(vBlobDec);
-- dbms_output.put_line('<BlobDecLength>' || vBlobDecLen);
-- dbms_output.put_line('Finshed base64 decoding.');
RETURN vBlobDec;
END decodeBase642Blob;
function base64encode(p_blob in blob)
return clob
is
CRLF constant varchar2(2) := chr(13)||chr(10);
l_clob clob;
l_amount integer := 23826;
l_offset integer := 1;
l_raw raw(32767);
l_buf varchar2(32767);
l_len integer := dbms_lob.getlength(p_blob);
begin
dbms_lob.createtemporary(l_clob, true, dbms_lob.call);
while l_offset <= l_len loop
dbms_lob.read(p_blob, l_amount, l_offset, l_raw);
l_offset := l_offset + l_amount;
l_buf := utl_raw.cast_to_varchar2(utl_encode.base64_encode(l_raw));
l_buf := replace(l_buf, CRLF);
dbms_lob.writeappend(l_clob, length(l_buf), l_buf);
end loop;
return l_clob;
end base64encode;
end;
```

265
docs/packages/XLIB_COMPONENT.md Normal file
View File

@@ -0,0 +1,265 @@
# XLIB_COMPONENT
## Package Specification
```sql
PACKAGE "XLIB_COMPONENT"
AS
/*=========================================================================
$Id: xlib_component.pks 57 2013-05-13 07:09:51Z dietmar.aust $
Purpose :
License : Copyright (c) 2010 Dietmar Aust (opal-consulting.de)
Licensed under a BSD style license (license.txt)
http://www.opal-consulting.de/pls/apex/f?p=20090928:14
$LastChangedDate: 2013-05-13 09:09:51 +0200 (Mon, 13 May 2013) $
$LastChangedBy: dietmar.aust $
Date Author Comment
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
06.01.2010 D. Aust Initial creation
=========================================================================*/
-- how many digits does the version key have?
-- 3 => e.g. 1.0.0
-- 4 => e.g. 1.0.0.0
c_num_version_components CONSTANT NUMBER := 6;
PROCEDURE create_component (
p_name xlib_components.comp_name%TYPE,
p_version xlib_components.comp_version%TYPE,
p_version_label xlib_components.comp_version_label%TYPE DEFAULT NULL,
p_depends_on xlib_components.comp_depends_on%TYPE DEFAULT NULL
);
PROCEDURE set_component (
p_name xlib_components.comp_name%TYPE,
p_version xlib_components.comp_version%TYPE,
p_version_label xlib_components.comp_version_label%TYPE DEFAULT NULL,
p_depends_on xlib_components.comp_depends_on%TYPE DEFAULT NULL
);
PROCEDURE delete_component (p_name IN xlib_components.comp_name%TYPE);
/*****
utility functions
****/
FUNCTION get_version (p_name IN xlib_components.comp_name%TYPE)
RETURN xlib_components.comp_version%TYPE;
FUNCTION make_version_string (p_version IN VARCHAR2)
RETURN VARCHAR2;
PROCEDURE verify_required_component (
p_comp_name IN VARCHAR2,
p_comp_version_min IN VARCHAR2
);
END xlib_component;```
## Package Body
```sql
PACKAGE BODY "XLIB_COMPONENT"
AS
/*=========================================================================
FILE : $Id: xlib_component.pkb 57 2013-05-13 07:09:51Z dietmar.aust $
=========================================================================*/
TYPE vc2_arr_t IS TABLE OF VARCHAR2 (32767 CHAR)
INDEX BY BINARY_INTEGER;
PROCEDURE create_component (
p_name xlib_components.comp_name%TYPE,
p_version xlib_components.comp_version%TYPE,
p_version_label xlib_components.comp_version_label%TYPE DEFAULT NULL,
p_depends_on xlib_components.comp_depends_on%TYPE DEFAULT NULL
)
IS
BEGIN
INSERT INTO xlib_components
(comp_id, comp_name, comp_version, comp_version_label, comp_depends_on
)
VALUES (xlib_seq.NEXTVAL, p_name, p_version, p_version_label, p_depends_on
);
END;
PROCEDURE set_component (
p_name xlib_components.comp_name%TYPE,
p_version xlib_components.comp_version%TYPE,
p_version_label xlib_components.comp_version_label%TYPE DEFAULT NULL,
p_depends_on xlib_components.comp_depends_on%TYPE DEFAULT NULL
)
IS
BEGIN
INSERT INTO xlib_components
(comp_id, comp_name, comp_version, comp_version_label, comp_depends_on
)
VALUES (xlib_seq.NEXTVAL, p_name, p_version, p_version_label, p_depends_on
);
EXCEPTION
WHEN DUP_VAL_ON_INDEX
THEN
UPDATE xlib_components
SET comp_version = p_version,
comp_version_label = p_version_label,
comp_depends_on = p_depends_on
WHERE comp_name = p_name;
IF SQL%ROWCOUNT = 0
THEN
raise_application_error (-20006,
'component ' || p_name || ' not found'
);
END IF;
END;
PROCEDURE delete_component (p_name IN xlib_components.comp_name%TYPE)
IS
BEGIN
-- delete component
DELETE FROM xlib_components
WHERE comp_name = p_name;
IF SQL%ROWCOUNT = 0
THEN
raise_application_error (-20001,
'Component ' || p_name || ' not found'
);
END IF;
END;
FUNCTION split_string (p_str IN VARCHAR2, p_sep IN VARCHAR2 DEFAULT ',')
RETURN vc2_arr_t
AS
l_string VARCHAR2 (32767) := p_str || p_sep;
l_sep_index PLS_INTEGER;
l_index PLS_INTEGER := 1;
l_tab vc2_arr_t;
BEGIN
-- assertions
IF LENGTH (p_sep) != 1
THEN
raise_application_error
(-20004,
'wrong separator format, must be only one character'
);
END IF;
LOOP
l_sep_index := INSTR (l_string, p_sep, l_index);
EXIT WHEN l_sep_index = 0;
l_tab (l_tab.COUNT) :=
SUBSTR (l_string, l_index, l_sep_index - l_index);
l_index := l_sep_index + 1;
END LOOP;
RETURN l_tab;
END;
FUNCTION get_version (p_name IN xlib_components.comp_name%TYPE)
RETURN xlib_components.comp_version%TYPE
IS
l_version xlib_components.comp_version%TYPE;
BEGIN
SELECT comp_version
INTO l_version
FROM xlib_components
WHERE comp_name = p_name;
RETURN l_version;
END;
PROCEDURE assert_version_format (p_version IN VARCHAR2)
IS
l_tab vc2_arr_t;
l_num NUMBER;
BEGIN
-- '.' at the beginning or end of the version?
IF SUBSTR (p_version, 1, 1) = '.'
OR SUBSTR (p_version, LENGTH (p_version), 1) = '.'
OR INSTR (p_version, ' ') > 0
THEN
raise_application_error (-20002, 'wrong version format');
END IF;
l_tab := split_string (p_version, '.');
FOR i IN 0 .. l_tab.COUNT - 1
LOOP
l_num := TO_NUMBER (l_tab (i));
END LOOP;
EXCEPTION
WHEN OTHERS
THEN
IF SQLCODE = -6502 /* numeric or value error */
THEN
raise_application_error (-20005,
'wrong version format, no numbers.'
);
ELSE
RAISE;
END IF;
END;
FUNCTION make_version_string (p_version IN VARCHAR2)
RETURN VARCHAR2
IS
l_num_dots NUMBER;
l_tab vc2_arr_t;
l_str VARCHAR2 (32767 CHAR);
l_comp VARCHAR2 (50 CHAR);
BEGIN
-- assertions
assert_version_format (p_version => p_version);
l_tab := split_string (p_version, '.');
FOR i IN 1 .. c_num_version_components
LOOP
IF l_tab.EXISTS (i - 1)
THEN
l_comp :=
TO_CHAR (TO_NUMBER (NVL (l_tab (i - 1), '0')), 'FM0000');
ELSE
l_comp := '0000';
END IF;
IF l_str IS NULL
THEN
l_str := l_comp;
ELSE
l_str := l_str || '.' || l_comp;
END IF;
END LOOP;
RETURN l_str;
END;
PROCEDURE verify_required_component (
p_comp_name IN VARCHAR2,
p_comp_version_min IN VARCHAR2
)
IS
l_current_version VARCHAR2 (50);
BEGIN
l_current_version := xlib_component.get_version (p_name => p_comp_name);
IF make_version_string (l_current_version)
>= make_version_string (p_comp_version_min)
THEN
NULL; -- ok
ELSE
raise_application_error
(-20020,
'this upgrade requires '||p_comp_name||' in version '
|| p_comp_version_min
|| ' or higher, not version '
|| l_current_version
);
END IF;
END;
END xlib_component;```

477
docs/packages/XLIB_HTTP.md Normal file
View File

@@ -0,0 +1,477 @@
# XLIB_HTTP
## Package Specification
```sql
PACKAGE "XLIB_HTTP"
AS
/*=========================================================================
Purpose : Make http callouts
License : Copyright (c) 2010 Dietmar Aust (opal-consulting.de)
Licensed under a BSD style license (license.txt)
http://www.opal-consulting.de/pls/apex/f?p=20090928:14
Version Date Author Comment
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
19.02.2007 D. Aust initial creation
07.08.2008 D. Aust - added check_get_request
- display_url_raw: pass all request headers
to the client
05.08.2012 D. Aust suppress mime header TRANSFER-ENCODING,
causes lots of problems with XMLDB listener
and others choking.
2.3.0.0 19.05.2014 D. Aust - #294 - Fix chunked encoding problem in
xlib_http.get_report
- added version information to this package
2.3.0.0 09.05.2015 D. Aust pass JSESSIONID from backend J2EE server to client
for image rendering in html reports
2.6.1 28.09.2020 D. Aust - #40 - APEX 20.1 security bundle (PSE 30990551) rejects response header "Cache-Control: private"
2.6.2 13.10.2020 D. Aust - added function check_acl()
=========================================================================*/
c_success CONSTANT CHAR (1) := '1';
c_fail CONSTANT CHAR (1) := '0';
-- version of this package
version_c constant varchar2(20 char) := '2.6.2';
TYPE vc_arr_t IS TABLE OF VARCHAR2 (32767) INDEX BY BINARY_INTEGER;
g_empty_vc_arr vc_arr_t;
/* Function: MyFunction
*
* Parameters:
*
* x - Description of x.
* y - Description of y.
* z - Description of z.
*/
PROCEDURE display_url_raw (
p_url VARCHAR2,
p_mime_type_override IN VARCHAR2 DEFAULT NULL,
p_charset IN VARCHAR2 DEFAULT NULL,
p_header_name_arr IN vc_arr_t default g_empty_vc_arr,
p_header_value_arr IN vc_arr_t default g_empty_vc_arr
);
/* Procedure: retrieve_blob_from_url
Multiplies two integers.
Parameters:
p_url - url to be called
o_blob - output: the resulting out blob
o_mime_type - output: the resulting out mime type from the call
Returns:
The two integers multiplied together.
o_blob - the resulting out blob
See Also:
<escape_form_data>
*/
PROCEDURE retrieve_blob_from_url (
p_url VARCHAR2,
o_blob OUT BLOB,
o_mime_type OUT VARCHAR2
);
/*
Function: escape_form_data
Here is some describing text ...
--- SQL
declare
l_i number;
begin
null;
Select count(*)
into l_count
from dual;
end;
---
Parameters:
s - string to be escaped
Returns:
the escaped data
*/
FUNCTION escape_form_data (s VARCHAR2)
RETURN VARCHAR2;
/*
Function: check_get_request
Parameters:
p_url the url to be called
Returns:
Returns c_fail or c_success
*/
FUNCTION check_get_request (p_url VARCHAR2)
RETURN CHAR;
/*
Function: check_acl
Parameters:
p_url the url to be called
Returns:
Returns c_fail or c_success
*/
FUNCTION check_acl (p_url VARCHAR2)
RETURN CHAR;
END;```
## Package Body
```sql
PACKAGE BODY "XLIB_HTTP"
AS
/*=========================================================================
Purpose : Make http callouts
License : Copyright (c) 2010 Dietmar Aust (opal-consulting.de)
Licensed under a BSD style license (license.txt)
https://github.com/daust/JasperReportsIntegration
Version Date Author Comment
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
19.02.2007 D. Aust initial creation
07.08.2008 D. Aust - added check_get_request
- display_url_raw: pass all request headers
to the client
05.08.2012 D. Aust suppress mime header TRANSFER-ENCODING,
causes lots of problems with XMLDB listener
and others choking.
2.3.0.0 19.05.2014 D. Aust - #294 - Fix chunked encoding problem in
xlib_http.get_report
- added version information to this package
2.3.0.0 09.05.2015 D. Aust pass JSESSIONID from backend J2EE server to client
for image rendering in html reports
2.6.1 28.09.2020 D. Aust - #40 - APEX 20.1 security bundle (PSE 30990551) rejects response header "Cache-Control: private"
2.6.2 13.10.2020 D. Aust - added function check_acl()
=========================================================================*/
m_module VARCHAR2 (50) := 'XLIB_HTTP';
PROCEDURE display_url_raw (
p_url VARCHAR2,
p_mime_type_override IN VARCHAR2 DEFAULT NULL,
p_charset IN VARCHAR2 DEFAULT NULL,
p_header_name_arr IN vc_arr_t default g_empty_vc_arr,
p_header_value_arr IN vc_arr_t default g_empty_vc_arr
)
IS
l_http_request UTL_HTTP.req;
l_http_response UTL_HTTP.resp;
l_blob BLOB;
l_raw RAW (32767);
l_buffer_size NUMBER := 32767;
--
l_proc VARCHAR2 (100) := m_module || '.DISPLAY_URL_RAW';
--
l_mime_type VARCHAR2 (100);
l_header_name VARCHAR2 (256);
l_header_value VARCHAR2 (1024);
l_jsession VARCHAR2 (256);
l_path VARCHAR2 (1024);
--
l_header_name_arr vc_arr_t;
l_header_value_arr vc_arr_t;
--
l_msg varchar2(32767);
BEGIN
xlog (l_proc, 'show url: ' || p_url);
--htp.flush();
--htp.init();
-- Initialize the BLOB.
DBMS_LOB.createtemporary (l_blob, FALSE);
l_http_request := UTL_HTTP.begin_request (url => p_url,
method => 'GET',
http_version => utl_http.http_version_1_0);
utl_http.set_header (l_http_request, 'Connection', 'Keep-Alive');
-- pass additional headers to the target service
for i in 1..p_header_name_arr.count loop
xlog(l_proc, 'pass additional headers to target service: '|| p_header_name_arr(i) ||': '||p_header_value_arr(i));
utl_http.set_header(l_http_request, p_header_name_arr(i), p_header_value_arr(i));
end loop;
-- get response from target service
l_http_response := UTL_HTTP.get_response (l_http_request);
FOR i IN 1 .. UTL_HTTP.get_header_count (l_http_response)
LOOP
UTL_HTTP.get_header (l_http_response,
i,
l_header_name,
l_header_value
);
-- store header value in arr
l_header_name_arr (i) := l_header_name;
l_header_value_arr (i) := l_header_value;
IF LOWER (l_header_name) = 'content-type'
THEN
l_mime_type := l_header_value;
xlog(l_proc, 'content-type from server: ' || l_mime_type);
END IF;
END LOOP;
-- override mime type
IF p_mime_type_override IS NOT NULL
THEN
l_mime_type := p_mime_type_override;
END IF;
-- Copy the response into the BLOB.
BEGIN
LOOP
UTL_HTTP.read_raw (l_http_response, l_raw, l_buffer_size);
DBMS_LOB.writeappend (l_blob, UTL_RAW.LENGTH (l_raw), l_raw);
END LOOP;
EXCEPTION
WHEN UTL_HTTP.end_of_body
THEN
UTL_HTTP.end_response (l_http_response);
END;
xlog(l_proc, 'set content-type: ' || l_mime_type);
OWA_UTIL.mime_header (ccontent_type => l_mime_type,
bclose_header => FALSE,
ccharset => p_charset
);
FOR i IN 1 .. l_header_name_arr.COUNT
LOOP
IF UPPER (l_header_name_arr (i)) IN
('CONTENT-LENGTH', 'CONTENT-TYPE', 'MIME-TYPE', 'TRANSFER-ENCODING',
'STRICT-TRANSPORT-SECURITY', 'CACHE-CONTROL', 'PRAGMA', 'EXPIRES')
THEN
--xlog (l_proc, 'skip header ' || l_header_name_arr (i));
null;
ELSE
if upper(l_header_name_arr(i)) = 'SET-COOKIE' and l_header_value_arr (i) like 'JSESSIONID%' then
xlog(l_proc , 'JSESSION_ID found !!!:'||l_header_value_arr (i));
--extract path
l_jsession := regexp_substr(l_header_value_arr (i), 'JSESSIONID=(.*);[ ]*Path',1, 1,'i',1);
l_path := regexp_substr(l_header_value_arr (i), ';[ ]*Path=(.*)',1, 1,'i',1);
xlog(l_proc, 'xx:full:'||l_header_value_arr (i)|| '; xx:session:'||l_jsession || '; xx:path:'||l_path);
else
l_header_value := l_header_value_arr (i);
end if;
xlog (l_proc,
'set header:'
|| l_header_name_arr (i)
|| ': '
|| l_header_value
);
HTP.p (l_header_name_arr (i) || ': ' || l_header_value);
END IF;
END LOOP;
-- JSESSION Cookies ausgeben
-- if using tunnel, then the cookie is JRI_JSESSIONID
-- if not using tunnel, then cookie is JSESSIONID directly
--
if xlib_jasperreports.get_use_images_no_tunnel=false then
l_msg := 'Set-Cookie: ' || xlib_jasperreports.m_jri_cookie_name_c || '=' || l_jsession;
xlog (l_proc, 'set header:' || l_msg );
HTP.p (l_msg);
l_msg := 'Set-Cookie: ' || xlib_jasperreports.m_jri_path_cookie_name_c || '=' || l_path;
xlog (l_proc, 'set header:' || l_msg );
HTP.p (l_msg);
else
l_msg := 'Set-Cookie: JSESSIONID=' || l_jsession;
if xlib_jasperreports.get_cookie_path_no_tunnel is not null then
l_msg := l_msg || '; Path=' || xlib_jasperreports.get_cookie_path_no_tunnel;
end if;
xlog (l_proc, 'set header:' || l_msg );
HTP.p (l_msg);
end if;
-- set content length
HTP.p ('Content-length: ' || DBMS_LOB.getlength (l_blob));
OWA_UTIL.http_header_close;
WPG_DOCLOAD.download_file (l_blob);
-- Relase the resources associated with the temporary LOB.
DBMS_LOB.freetemporary (l_blob);
EXCEPTION
WHEN UTL_HTTP.end_of_body
THEN
UTL_HTTP.end_response (l_http_response);
DBMS_LOB.freetemporary (l_blob);
RAISE;
WHEN OTHERS
THEN
xlog (l_proc, 'Error: ' || SQLERRM, 'ERROR');
RAISE;
END;
PROCEDURE retrieve_blob_from_url (
p_url VARCHAR2,
o_blob OUT BLOB,
o_mime_type OUT VARCHAR2
)
IS
l_http_request UTL_HTTP.req;
l_http_response UTL_HTTP.resp;
l_raw RAW (32767);
--
l_proc VARCHAR2 (100)
:= m_module || '.RETRIEVE_BLOB_FROM_URL';
--
l_header_name VARCHAR2 (256);
l_header_value VARCHAR2 (1024);
BEGIN
-- Initialize the BLOB.
dbms_lob.createtemporary (o_blob, false);
l_http_request := utl_http.begin_request (url => p_url,
method => 'GET',
http_version => utl_http.http_version_1_0);
l_http_response := UTL_HTTP.get_response (l_http_request);
FOR i IN 1 .. UTL_HTTP.get_header_count (l_http_response)
LOOP
UTL_HTTP.get_header (l_http_response,
i,
l_header_name,
l_header_value
);
IF LOWER (l_header_name) = 'content-type'
THEN
o_mime_type := l_header_value;
END IF;
END LOOP;
-- Copy the response into the BLOB.
BEGIN
LOOP
UTL_HTTP.read_raw (l_http_response, l_raw, 32767);
DBMS_LOB.writeappend (o_blob, UTL_RAW.LENGTH (l_raw), l_raw);
END LOOP;
EXCEPTION
WHEN UTL_HTTP.end_of_body
THEN
UTL_HTTP.end_response (l_http_response);
END;
-- Relase the resources associated with the temporary LOB.
--DBMS_LOB.freetemporary (l_blob);
EXCEPTION
WHEN OTHERS
THEN
UTL_HTTP.end_response (l_http_response);
DBMS_LOB.freetemporary (o_blob);
xlog (l_proc, 'Error: ' || SQLERRM, 'ERROR');
RAISE;
END;
FUNCTION escape_form_data (s VARCHAR2)
RETURN VARCHAR2
IS
l_s VARCHAR2 (500 CHAR);
FUNCTION r (s VARCHAR2, c VARCHAR2)
RETURN VARCHAR2
IS
BEGIN
RETURN REPLACE (s, c, '%' || TRIM (TO_CHAR (ASCII (c), 'XX')));
END;
BEGIN
l_s := s;
l_s := REPLACE (l_s, ' ', '+');
l_s := r (l_s, chr(37)); -- %
l_s := r (l_s, chr(37)); -- /
l_s := r (l_s, chr(63)); -- ?
l_s := r (l_s, chr(38)); -- &
l_s := r (l_s, chr(228)); -- <20><><EFBFBD>
l_s := r (l_s, chr(196)); -- <20><>
l_s := r (l_s, chr(246)); -- <20><>
l_s := r (l_s, chr(214)); -- <20><>
l_s := r (l_s, chr(252)); -- <20><>
l_s := r (l_s, chr(220)); -- <20><><EFBFBD>
l_s := r (l_s, chr(223)); -- <20><><EFBFBD>
RETURN l_s;
END;
FUNCTION check_get_request (p_url VARCHAR2)
RETURN CHAR
IS
l_clob CLOB;
BEGIN
IF p_url IS NULL
THEN
RETURN c_fail;
END IF;
SELECT HTTPURITYPE (p_url).getclob ()
INTO l_clob
FROM DUAL;
/*SELECT c_success
INTO l_ret
FROM DUAL
WHERE EXISTS (SELECT HTTPURITYPE (p_url).getclob ()
FROM DUAL);
*/
RETURN c_success;
EXCEPTION
WHEN OTHERS
THEN
RETURN c_fail;
END;
FUNCTION check_acl (p_url VARCHAR2)
RETURN CHAR
IS
l_clob CLOB;
BEGIN
IF p_url IS NULL
THEN
RETURN c_fail;
END IF;
SELECT HTTPURITYPE (p_url).getclob ()
INTO l_clob
FROM DUAL;
/*SELECT c_success
INTO l_ret
FROM DUAL
WHERE EXISTS (SELECT HTTPURITYPE (p_url).getclob ()
FROM DUAL);
*/
RETURN c_success;
EXCEPTION
WHEN OTHERS
THEN
-- acl problem
if sqlcode=24247 then
RETURN c_fail;
else
-- no acl problem
return c_success;
end if;
END;
END;```

721
docs/packages/XLIB_JASPERREPORTS.md Normal file
View File

@@ -0,0 +1,721 @@
# XLIB_JASPERREPORTS
## Package Specification
```sql
PACKAGE "XLIB_JASPERREPORTS"
AS
/*=========================================================================
Purpose :
License : Copyright (c) 2010 Dietmar Aust (opal-consulting.de)
Licensed under a BSD style license (license.txt)
http://www.opal-consulting.de/pls/apex/f?p=20090928:14
$LastChangedDate: 2018-09-30 09:00:44 +0200 (So, 30 Sep 2018) $
$LastChangedBy: dietmar.aust $
Version Date Author Comment
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
06.01.2010 D. Aust Initial creation
06.05.2011 D. Aust added constants for xlsx and docx
05.08.2012 D. Aust added version 2.0.0 features:
- direct printing
- save file on server
11.05.2013 D. Aust added support for tunneling images for html
exports only
2.3.0.0 19.05.2014 D. Aust - #294 - Fix chunked encoding problem in
xlib_http.get_report
- added version information to this package
2.4.0.0 15.10.2017 D. Aust FEATURE: #3941 - Support for timeZones
(report parameter REPORT_TIME_ZONE)
2.5.0.0 29.09.2018 D. Aust FEATURE: #9 - Ability to set Printjob name (programmatically)
2.5.0.1 30.09.2018 D. Aust fix bool2string issue
2.6.1 01.10.2020 D. Aust add get_default_configuration() and set_default_configuration()
2.6.2 13.10.2020 D. Aust #54 - Timeout value from default table not working
=========================================================================*/
-- version of this package
version_c constant varchar2(20 char) := '2.6.2';
-- constants
-- supported formats
c_rep_format_pdf CONSTANT VARCHAR2 (20) := 'pdf';
c_rep_format_rtf CONSTANT VARCHAR2 (20) := 'rtf';
c_rep_format_xls CONSTANT VARCHAR2 (20) := 'xls';
c_rep_format_html constant varchar2 (20) := 'html';
c_rep_format_html2 CONSTANT VARCHAR2 (20) := 'html2';
c_rep_format_csv CONSTANT VARCHAR2 (20) := 'csv';
c_rep_format_docx CONSTANT VARCHAR2 (20) := 'docx';
c_rep_format_pptx CONSTANT VARCHAR2 (20) := 'pptx';
c_rep_format_xlsx CONSTANT VARCHAR2 (20) := 'xlsx';
-- images uri
--c_images_uri_tunnel constant varchar2(100 char)
-- := 'xlib_jasperreports_img.get_image?p_url=#REPORT_URL#&p_image=';
-- #IMAGE_NAME# and #J2EE_CONTEXT# will be substituted on the J2EE server side
m_jri_cookie_name_c CONSTANT VARCHAR2 (50) := 'JRI_SESSIONID';
m_jri_path_cookie_name_c CONSTANT VARCHAR2 (50) := 'JRI_PATH';
c_images_uri_tunnel constant varchar2(500 char) := 'wwv_flow.show?p_request=APPLICATION_PROCESS%3DJRI_SHOW_IMAGE&p_flow_id=#APP_ID#&p_flow_step_id=0&p_instance=#APP_SESSION#&x01=#IMAGE_NAME#';
c_images_uri_no_tunnel constant varchar2(500 char) := '#J2EE_CONTEXT_PATH#/report_image?image=#IMAGE_NAME#';
-- exceptions
report_url_not_defined EXCEPTION;
----------------------------------------------------------------------------
-- sets the url for the report server for all requests in the
-- current session
----------------------------------------------------------------------------
PROCEDURE set_report_url (p_report_url IN VARCHAR2);
FUNCTION get_report_url
RETURN VARCHAR2;
----------------------------------------------------------------------------
-- set the image uri for html reports only!
----------------------------------------------------------------------------
PROCEDURE set_images_uri (p_images_uri IN VARCHAR2 default null);
procedure use_images_no_tunnel (p_server_uri in varchar2 default null, p_cookie_path varchar2 default null);
function get_use_images_no_tunnel return boolean;
FUNCTION get_images_uri
return varchar2;
FUNCTION get_cookie_path_no_tunnel
RETURN VARCHAR2;
/** make a callout with utl_http to the j2ee container running the
* JasperReportsIntegration web application
* => return the results
*
* @param p_rep_name name of the report (needs a name.jasper file deployed on the server)
* @param p_rep_format report format, e.g. pdf, rtf, etc, see constants
* @param p_data_source data source name, needs to be configured in J2EE application
* @param p_out_filename filename if the file should be downloaded
* @param p_rep_locale report locale setting, e.g. de_DE or en_US
* @param p_rep_encoding encoding, e.g. UTF-8
* @param p_additional_params additional parameters, e.g.: p1=1&p2=2
* @param p_print_is_enabled shall the report be sent to the printer directly?
* @param p_print_printer_name name or substring of printer name
* @param p_print_media media used, either the paper size or the tray
* @param p_print_copies number of copies to be printed
* @param p_print_duplex duplex printing?
* @param p_print_collate sorting the print output?
* @param p_save_is_enabled shall the generated file be saved on the server?
* @param p_rep_time_zone "time zone" parameter for the execution of the report,
a list of valid entries can be found here:
https://en.wikipedia.org/wiki/List_of_tz_database_time_zones
E.g.: Europe/Berlin, UCT, US/Central, US/Pacific,
Etc/Greenwich, Europe/London
* @param p_save_filename filename for the file to be saved on the server
* @param p_print_job_name name of the print job name, by default it uses: JasperReports - <report name>
*
*/
PROCEDURE show_report (
p_rep_name IN VARCHAR2 DEFAULT 'test',
p_rep_format IN VARCHAR2 DEFAULT c_rep_format_pdf,
p_data_source IN VARCHAR2 DEFAULT 'default',
p_out_filename IN VARCHAR2 DEFAULT NULL,
p_rep_locale in varchar2 default 'de_DE',
p_rep_encoding in varchar2 default 'UTF-8',
p_additional_params in varchar2 default null,
p_print_is_enabled in boolean default false,
p_print_printer_name in varchar2 default null,
p_print_media in varchar2 default null,
p_print_copies in number default 1,
p_print_duplex in boolean default false,
p_print_collate in boolean default false,
p_save_is_enabled in boolean default false,
p_save_filename in varchar2 default null,
p_rep_time_zone in varchar2 default null,
p_print_job_name in varchar2 default null
);
/* tunnels images for html reports */
procedure show_image(p_image_name IN VARCHAR2);
/** run the report and return the result as a blob
*
* @param p_rep_name name of the report (needs a name.jasper file deployed on the server)
* @param p_rep_format report format, e.g. pdf, rtf, etc, see constants
* @param p_data_source data source name, needs to be configured in J2EE application
* @param p_out_filename filename if the file should be downloaded
* @param p_rep_locale report locale setting, e.g. de_DE or en_US
* @param p_rep_encoding encoding, e.g. UTF-8
* @param p_additional_params additional parameters, e.g.: p1=1&p2=2
* @param p_print_is_enabled shall the report be sent to the printer directly?
* @param p_print_printer_name name or substring of printer name
* @param p_print_media media used, either the paper size or the tray
* @param p_print_copies number of copies to be printed
* @param p_print_duplex duplex printing?
* @param p_print_collate sorting the print output?
* @param p_save_is_enabled shall the generated file be saved on the server?
* @param p_save_filename filename for the file to be saved on the server
* @param p_rep_time_zone "time zone" parameter for the execution of the report,
a list of valid entries can be found here:
https://en.wikipedia.org/wiki/List_of_tz_database_time_zones
E.g.: Europe/Berlin, UCT, US/Central, US/Pacific,
Etc/Greenwich, Europe/London
* @param p_out_blob the blob will be returned here
* @param p_out_mime_type the proper mime type of the generated file
* @param p_print_job_name name of the print job name, by default it uses: JasperReports - <report name>
*
*/
PROCEDURE get_report (
p_rep_name IN VARCHAR2 DEFAULT 'test',
p_rep_format in varchar2 default c_rep_format_pdf,
p_data_source IN VARCHAR2 DEFAULT 'default',
p_rep_locale in varchar2 default 'de_DE',
p_rep_encoding IN VARCHAR2 DEFAULT 'UTF-8',
p_additional_params in varchar2 default null,
p_print_is_enabled in boolean default false,
p_print_printer_name in varchar2 default null,
p_print_media in varchar2 default null,
p_print_copies in number default 1,
p_print_duplex in boolean default false,
p_print_collate in boolean default false,
p_save_is_enabled in boolean default false,
p_save_filename in varchar2 default null,
p_rep_time_zone in varchar2 default null,
p_out_blob IN OUT BLOB,
p_out_mime_type IN OUT VARCHAR2,
p_print_job_name in varchar2 default null
);
----------------------------------------------------------------------------
-- get default configuration
----------------------------------------------------------------------------
FUNCTION get_default_configuration
return xlib_jasperreports_conf%rowtype;
----------------------------------------------------------------------------
-- set default configuration
----------------------------------------------------------------------------
PROCEDURE set_default_configuration(p_conf in out xlib_jasperreports_conf%rowtype);
PROCEDURE set_default_configuration (
p_protocol IN xlib_jasperreports_conf.conf_protocol%TYPE default 'http',
p_server IN xlib_jasperreports_conf.conf_server%TYPE default 'localhost',
p_port IN xlib_jasperreports_conf.conf_port%TYPE default '80',
p_context_path IN xlib_jasperreports_conf.conf_context_path%TYPE default 'jri',
p_wallet_path IN xlib_jasperreports_conf.conf_wallet_path%TYPE default null,
p_wallet_pwd IN xlib_jasperreports_conf.conf_wallet_pwd%TYPE default null,
p_http_transfer_timeout IN xlib_jasperreports_conf.conf_http_transfer_timeout%TYPE default 60);
END;```
## Package Body
```sql
PACKAGE BODY "XLIB_JASPERREPORTS"
AS
/*=========================================================================
Purpose :
License : Copyright (c) 2010 Dietmar Aust (opal-consulting.de)
Licensed under a BSD style license (license.txt)
http://www.opal-consulting.de/pls/apex/f?p=20090928:14
$LastChangedDate: 2018-09-30 09:00:44 +0200 (So, 30 Sep 2018) $
$LastChangedBy: dietmar.aust $
Version Date Author Comment
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
06.01.2010 D. Aust Initial creation
06.05.2011 D. Aust added constants for xlsx and docx
05.08.2012 D. Aust added version 2.0.0 features:
- direct printing
- save file on server
11.05.2013 D. Aust added support for tunneling images for html
exports only
2.3.0.0 19.05.2014 D. Aust - #294 - Fix chunked encoding problem in
xlib_http.get_report
- added version information to this package
2.4.0.0 15.10.2017 D. Aust FEATURE: #3941 - Support for timeZones
(report parameter REPORT_TIME_ZONE)
2.5.0.0 29.09.2018 D. Aust FEATURE: #9 - Ability to set Printjob name (programmatically)
2.5.0.1 30.09.2018 D. Aust fix bool2string issue
2.6.1 01.10.2020 D. Aust add get_default_configuration() and set_default_configuration()
2.6.2 13.10.2020 D. Aust #54 - Timeout value from default table not working
=========================================================================*/
m_module constant varchar2 (100) := $$plsql_unit;
m_report_url VARCHAR2 (32767) := NULL;
m_images_uri VARCHAR2 (32767) := NULL;
m_use_images_no_tunnel boolean := false;
m_cookie_path_no_tunnel varchar2(200 char) := null;
-- convert boolean to 'true' or 'false'
FUNCTION bool2string (b IN BOOLEAN)
RETURN VARCHAR2
IS
BEGIN
IF b
THEN
RETURN 'true';
ELSE
RETURN 'false';
END IF;
END;
procedure setup_configuration_defaults
is
l_conf xlib_jasperreports_conf%rowtype;
l_timeout PLS_INTEGER;
begin
l_conf := get_default_configuration();
-- override report url if not defined
if m_report_url is null then
m_report_url := l_conf.conf_protocol || '://'||l_conf.conf_server||':'||l_conf.conf_port||'/'||l_conf.conf_context_path||'/report';
xlog(p_module => m_module, p_msg => 'Override report url from defaults: '|| m_report_url, p_type=> 'DEBUG');
end if;
-- set wallet path and pwd
-- will ALWAYS override the settings, will ignore previous calls to set_wallet
-- at least we check whether the config table has an entry for the wallet or not.
-- thus it could work relying on the wallet set by APEX through the internal workspace! :)
if lower(m_report_url) like 'https%' and l_conf.conf_wallet_path is not null then
utl_http.set_wallet(l_conf.conf_wallet_path, l_conf.conf_wallet_pwd);
xlog(p_module => m_module, p_msg => 'Override wallet location/pwd from defaults', p_type=> 'DEBUG');
end if;
-- override http transfer timeout it not defined
utl_http.get_transfer_timeout( timeout => l_timeout );
--xlog(p_module => m_module, p_msg => 'Current setting of transfer_timeout: '||l_timeout, p_type=> 'DEBUG');
if (l_timeout is null or l_timeout=60 /*60 is the default*/) then
utl_http.set_transfer_timeout(l_conf.conf_http_transfer_timeout);
xlog(p_module => m_module, p_msg => 'Override http transfer timeout ('||l_timeout||'s) from defaults: '|| l_conf.conf_http_transfer_timeout ||'s', p_type=> 'DEBUG');
end if;
end;
PROCEDURE dump_all_cookies
IS
l_proc VARCHAR2 (100) := m_module || '.dump_all_cookies';
l_name_arr OWA_COOKIE.vc_arr;
l_vals_arr OWA_COOKIE.vc_arr;
l_vals_ret INTEGER;
BEGIN
xlog (l_proc, 'start');
OWA_COOKIE.get_all (names => l_name_arr, vals => l_vals_arr, num_vals => l_vals_ret);
xlog (l_proc, '#num of cookies: ' || l_vals_ret);
FOR i IN 1 .. l_name_arr.COUNT
LOOP
xlog (l_proc, i || ':' || l_name_arr (i) || '=' || l_vals_arr (i));
END LOOP;
xlog (l_proc, 'end');
END;
----------------------------------------------------------------------------
-- sets the url for the report server for all requests in the
-- current session
----------------------------------------------------------------------------
PROCEDURE set_report_url (p_report_url IN VARCHAR2)
IS
BEGIN
xlog ('set_report_url:', p_report_url);
m_report_url := p_report_url;
END;
FUNCTION get_report_url
RETURN VARCHAR2
IS
BEGIN
RETURN m_report_url;
END;
----------------------------------------------------------------------------
-- sets the images_uri only for http reports!
----------------------------------------------------------------------------
PROCEDURE set_images_uri (p_images_uri IN VARCHAR2)
IS
BEGIN
m_images_uri := p_images_uri;
END;
/* use the images from the application server when both /ords and /jri are
installed on the same application server
the p_server_uri parameter is rarely used, only when they are not run on the same application server
and the uri differs. But that comes with a lot of CORS and other cookie issues.
*/
procedure use_images_no_tunnel (p_server_uri in varchar2 default null, p_cookie_path varchar2 default null)
is
begin
m_use_images_no_tunnel := true;
m_cookie_path_no_tunnel := p_cookie_path;
-- the placeholders #J2EE_CONTEXT_PATH# and #IMAGE_NAME# will be replaced
-- inside the J2EE application with the current values of the deployment
set_images_uri( p_images_uri => p_server_uri || '#J2EE_CONTEXT_PATH#/report_image?image=#IMAGE_NAME#');
end;
function get_use_images_no_tunnel return boolean
is
begin
return m_use_images_no_tunnel;
end;
FUNCTION get_cookie_path_no_tunnel
RETURN VARCHAR2
IS
BEGIN
RETURN m_cookie_path_no_tunnel;
END;
FUNCTION get_images_uri
RETURN VARCHAR2
IS
BEGIN
RETURN m_images_uri;
END;
FUNCTION compute_images_uri_tunnel
RETURN VARCHAR2
IS
l_uri VARCHAR2 (32767 CHAR);
BEGIN
--l_uri := sys_context( 'userenv', 'current_schema' )
-- || '.' || c_images_uri_tunnel;
/*
c_images_uri_tunnel
:='xlib_jasperreports_img.get_image?p_url=#REPORT_URL#&p_image=';
*/
--l_uri := replace(l_uri, '#REPORT_URL#', APEX_UTIL.URL_ENCODE(m_report_url));
--l_uri := replace(l_uri, '#REPORT_URL#', m_report_url);
-- c_images_uri_tunnel constant varchar2(100 char) := 'wwv_flow.show?p_request=APPLICATION_PROCESS%3DJRI_SHOW_IMAGE&p_flow_id=#APP_ID#&p_flow_step_id=0&p_instance=#APP_SESSION#&x01=#IMG_NAME#';
l_uri := c_images_uri_tunnel;
l_uri := REPLACE (l_uri, '#APP_ID#', v ('APP_ID'));
l_uri := REPLACE (l_uri, '#APP_SESSION#', v ('APP_SESSION'));
xlog ('compute tunnel', l_uri);
RETURN l_uri;
END;
----------------------------------------------------------------------------
-- displays an image for html reports
----------------------------------------------------------------------------
PROCEDURE show_image (p_image_name IN VARCHAR2)
IS
l_proc VARCHAR2 (100) := m_module || '.show_image';
l_url VARCHAR2 (32767);
l_header_name_arr xlib_http.vc_arr_t;
l_header_value_arr xlib_http.vc_arr_t;
PROCEDURE get_headers_to_pass2j2ee (p_header_name_arr OUT xlib_http.vc_arr_t,
p_header_value_arr OUT xlib_http.vc_arr_t)
IS
l_proc VARCHAR2 (100) := m_module || '.get_headers_to_pass2j2ee';
jsession_cookie OWA_COOKIE.cookie;
jsession_path_cookie OWA_COOKIE.cookie;
BEGIN
jsession_cookie := OWA_COOKIE.get (name => m_jri_cookie_name_c);
jsession_path_cookie := OWA_COOKIE.get (name => m_jri_path_cookie_name_c);
xlog (l_proc, 'show jsession_id and path: ');
xlog (l_proc, jsession_cookie.vals (1));
xlog (l_proc, jsession_path_cookie.vals (1));
p_header_name_arr (p_header_name_arr.COUNT + 1) := 'Cookie';
p_header_value_arr (p_header_value_arr.COUNT + 1) :=
'JSESSIONID=' || jsession_cookie.vals (1) || ';Path=' || jsession_path_cookie.vals (1);
--xlog(l_proc, 'end');
EXCEPTION
WHEN OTHERS
THEN
xlog (l_proc, DBMS_UTILITY.format_error_backtrace, 'ERROR');
END;
BEGIN
xlog (l_proc, 'start: ### SHOW IMAGE: ' || p_image_name);
dump_all_cookies;
-- pick up defaults from table xlib_jasperreports_conf
setup_configuration_defaults();
-------------------------------------------------------
-- assert valid values for the input variables
-------------------------------------------------------
IF m_report_url IS NULL
THEN
RAISE report_url_not_defined;
END IF;
-------------------------------------------------------
-- construct URL
-------------------------------------------------------
-- _image?image=img_0_0_15&uuid=b41eb881-7ca5-4919-bd8f-5afa8d10b398
l_url := m_report_url || '_image';
l_url := l_url || '?image=' || p_image_name;
l_url := l_url || '&JSESSIONID=' || OWA_COOKIE.get (name => m_jri_cookie_name_c).vals (1);
-------------------------------------------------------
-- determine cookies for calling the j2ee server
-- JSESSIONID needs to be passed, the path needs to
-- be modified for the j2ee server context
-------------------------------------------------------
get_headers_to_pass2j2ee (p_header_name_arr => l_header_name_arr, p_header_value_arr => l_header_value_arr);
-------------------------------------------------------
-- call J2EE server
-------------------------------------------------------
xlib_http.
display_url_raw (p_url => l_url, p_header_name_arr => l_header_name_arr, p_header_value_arr => l_header_value_arr);
END;
----------------------------------------------------------------------------
-- make a callout with utl_http to the j2ee container running the
-- JasperReportsIntegration webapp
-- => return the results
----------------------------------------------------------------------------
PROCEDURE show_report (p_rep_name IN VARCHAR2 DEFAULT 'test',
p_rep_format IN VARCHAR2 DEFAULT c_rep_format_pdf,
p_data_source IN VARCHAR2 DEFAULT 'default',
p_out_filename IN VARCHAR2 DEFAULT NULL,
p_rep_locale IN VARCHAR2 DEFAULT 'de_DE',
p_rep_encoding IN VARCHAR2 DEFAULT 'UTF-8',
p_additional_params IN VARCHAR2 DEFAULT NULL,
p_print_is_enabled IN BOOLEAN DEFAULT FALSE,
p_print_printer_name IN VARCHAR2 DEFAULT NULL,
p_print_media IN VARCHAR2 DEFAULT NULL,
p_print_copies IN NUMBER DEFAULT 1,
p_print_duplex IN BOOLEAN DEFAULT FALSE,
p_print_collate IN BOOLEAN DEFAULT FALSE,
p_save_is_enabled IN BOOLEAN DEFAULT FALSE,
p_save_filename IN VARCHAR2 DEFAULT NULL,
p_rep_time_zone IN VARCHAR2 DEFAULT NULL,
p_print_job_name IN VARCHAR2 DEFAULT NULL)
IS
l_proc VARCHAR2 (100) := m_module || '.SHOW_REPORT';
l_url VARCHAR2 (32767);
BEGIN
-- pick up defaults from table xlib_jasperreports_conf
setup_configuration_defaults();
-------------------------------------------------------
-- assert valid values for the input variables
-------------------------------------------------------
IF m_report_url IS NULL
THEN
xlog(p_module => m_module, p_msg => 'The report url is empty', p_type=> 'ERROR');
RAISE report_url_not_defined;
END IF;
-------------------------------------------------------
-- construct URL
-------------------------------------------------------
l_url := m_report_url;
l_url := l_url || '?_repName=' || p_rep_name;
l_url := l_url || '&_repFormat=' || p_rep_format;
l_url := l_url || '&_dataSource=' || p_data_source;
l_url := l_url || '&_outFilename=' || p_out_filename;
l_url := l_url || '&_repLocale=' || p_rep_locale;
l_url := l_url || '&_repEncoding=' || p_rep_encoding;
l_url := l_url || '&_repTimeZone=' || APEX_UTIL.URL_ENCODE (p_rep_time_zone);
-- per default use the tunnel through the database
IF m_images_uri IS NULL OR m_images_uri = c_images_uri_tunnel
THEN
-- tunnel through database
l_url := l_url || '&_imagesURI=' || APEX_UTIL.URL_ENCODE (compute_images_uri_tunnel);
ELSE
-- use parameter, mostly for direct access to servlet
l_url := l_url || '&_imagesURI=' || APEX_UTIL.URL_ENCODE (m_images_uri);
END IF;
-- direct printing
l_url := l_url || '&_printIsEnabled=' || bool2string (p_print_is_enabled);
l_url := l_url || '&_printPrinterName=' || p_print_printer_name;
l_url := l_url || '&_printPrinterTray=' || p_print_media;
l_url := l_url || '&_printCopies=' || p_print_copies;
l_url := l_url || '&_printDuplex=' || bool2string (p_print_duplex);
l_url := l_url || '&_printCollate=' || bool2string (p_print_collate);
l_url := l_url || '&_printJobName=' || p_print_job_name;
-- save file on server
l_url := l_url || '&_saveIsEnabled=' || bool2string (p_save_is_enabled);
l_url := l_url || '&_saveFileName=' || p_save_filename;
/*
Each additional parameter needs to be escaped using utl_url.escape()
utl_url.escape(
url => p_additional_params,
escape_reserved_chars => true,
url_charset => 'UTF-8'
);
*/
-- additional report parameter passed?
IF (p_additional_params IS NOT NULL)
THEN
-- l_url := l_url || '&' || p_additional_params;
l_url := l_url || '&' || utl_url.escape(
url => p_additional_params,
escape_reserved_chars => false,
url_charset => 'UTF-8'
);
END IF;
-------------------------------------------------------
-- call J2EE server
-------------------------------------------------------
xlib_http.display_url_raw (p_url => l_url);
END;
----------------------------------------------------------------------------
-- run the report and return the result as a blob
----------------------------------------------------------------------------
PROCEDURE get_report (p_rep_name IN VARCHAR2 DEFAULT 'test',
p_rep_format IN VARCHAR2 DEFAULT c_rep_format_pdf,
p_data_source IN VARCHAR2 DEFAULT 'default',
p_rep_locale IN VARCHAR2 DEFAULT 'de_DE',
p_rep_encoding IN VARCHAR2 DEFAULT 'UTF-8',
p_additional_params IN VARCHAR2 DEFAULT NULL,
p_print_is_enabled IN BOOLEAN DEFAULT FALSE,
p_print_printer_name IN VARCHAR2 DEFAULT NULL,
p_print_media IN VARCHAR2 DEFAULT NULL,
p_print_copies IN NUMBER DEFAULT 1,
p_print_duplex IN BOOLEAN DEFAULT FALSE,
p_print_collate IN BOOLEAN DEFAULT FALSE,
p_save_is_enabled IN BOOLEAN DEFAULT FALSE,
p_save_filename IN VARCHAR2 DEFAULT NULL,
p_rep_time_zone IN VARCHAR2 DEFAULT NULL,
p_out_blob IN OUT BLOB,
p_out_mime_type IN OUT VARCHAR2,
p_print_job_name IN VARCHAR2 DEFAULT NULL)
IS
l_proc VARCHAR2 (100) := m_module || '.GET_REPORT';
l_url VARCHAR2 (32767);
BEGIN
-- pick up defaults from table xlib_jasperreports_conf
setup_configuration_defaults();
-------------------------------------------------------
-- assert valid values for the input variables
-------------------------------------------------------
IF m_report_url IS NULL
THEN
RAISE report_url_not_defined;
END IF;
-------------------------------------------------------
-- construct URL
-------------------------------------------------------
l_url := m_report_url;
l_url := l_url || '?_repName=' || p_rep_name;
l_url := l_url || '&_repFormat=' || p_rep_format;
l_url := l_url || '&_dataSource=' || p_data_source;
l_url := l_url || '&_repLocale=' || p_rep_locale;
l_url := l_url || '&_repEncoding=' || p_rep_encoding;
l_url := l_url || '&_repTimeZone=' || APEX_UTIL.URL_ENCODE (p_rep_time_zone);
-- per default use the tunnel through the database
IF m_images_uri IS NULL OR m_images_uri = c_images_uri_tunnel
THEN
-- tunnel through database
l_url := l_url || '&_imagesURI=' || APEX_UTIL.URL_ENCODE (compute_images_uri_tunnel);
ELSE
-- use parameter, mostly for direct access to servlet
l_url := l_url || '&_imagesURI=' || APEX_UTIL.URL_ENCODE (m_images_uri);
END IF;
-- direct printing
l_url := l_url || '&_printIsEnabled=' || bool2string (p_print_is_enabled);
l_url := l_url || '&_printPrinterName=' || p_print_printer_name;
l_url := l_url || '&_printPrinterTray=' || p_print_media;
l_url := l_url || '&_printCopies=' || p_print_copies;
l_url := l_url || '&_printDuplex=' || bool2string (p_print_duplex);
l_url := l_url || '&_printCollate=' || bool2string (p_print_collate);
l_url := l_url || '&_printJobName=' || p_print_job_name;
-- save file on server
l_url := l_url || '&_saveIsEnabled=' || bool2string (p_save_is_enabled);
l_url := l_url || '&_saveFileName=' || p_save_filename;
-- additional report parameter passed?
IF (p_additional_params IS NOT NULL)
THEN
-- l_url := l_url || '&' || p_additional_params;
l_url := l_url || '&' || utl_url.escape(
url => p_additional_params,
escape_reserved_chars => false,
url_charset => 'UTF-8'
);
END IF;
-------------------------------------------------------
-- call Tomcat
-------------------------------------------------------
xlib_http.retrieve_blob_from_url (p_url => l_url, o_blob => p_out_blob, o_mime_type => p_out_mime_type);
END;
----------------------------------------------------------------------------
-- get default configuration
----------------------------------------------------------------------------
FUNCTION get_default_configuration
RETURN xlib_jasperreports_conf%ROWTYPE
IS
l_conf xlib_jasperreports_conf%ROWTYPE;
BEGIN
SELECT *
INTO l_conf
FROM xlib_jasperreports_conf
WHERE conf_id = 'MAIN';
RETURN l_conf;
END;
----------------------------------------------------------------------------
-- set default configuration
----------------------------------------------------------------------------
PROCEDURE set_default_configuration (p_conf IN OUT xlib_jasperreports_conf%ROWTYPE)
IS
BEGIN
p_conf.conf_id := 'MAIN';
UPDATE xlib_jasperreports_conf
SET row = p_conf
WHERE conf_id = p_conf.conf_id;
END;
PROCEDURE set_default_configuration (
p_protocol IN xlib_jasperreports_conf.conf_protocol%TYPE default 'http',
p_server IN xlib_jasperreports_conf.conf_server%TYPE default 'localhost',
p_port IN xlib_jasperreports_conf.conf_port%TYPE default '80',
p_context_path IN xlib_jasperreports_conf.conf_context_path%TYPE default 'jri',
p_wallet_path IN xlib_jasperreports_conf.conf_wallet_path%TYPE default null,
p_wallet_pwd IN xlib_jasperreports_conf.conf_wallet_pwd%TYPE default null,
p_http_transfer_timeout IN xlib_jasperreports_conf.conf_http_transfer_timeout%TYPE default 60)
IS
BEGIN
UPDATE xlib_jasperreports_conf
SET conf_protocol = p_protocol,
conf_server = p_server,
conf_port = p_port,
conf_context_path = p_context_path,
conf_wallet_path = p_wallet_path,
conf_wallet_pwd = p_wallet_pwd,
conf_http_transfer_timeout = p_http_transfer_timeout
WHERE conf_id = 'MAIN';
END;
END;```

63
docs/packages/XLIB_JASPERREPORTS_IMG.md Normal file
View File

@@ -0,0 +1,63 @@
# XLIB_JASPERREPORTS_IMG
## Package Specification
```sql
PACKAGE XLIB_JASPERREPORTS_IMG AS
/*
$Id: xlib_jasperreports_img.pks 71 2017-10-15 16:25:51Z dietmar.aust $
*/
----------------------------------------------------------------------------
-- get_image: retrieves a report image from the server
----------------------------------------------------------------------------
PROCEDURE get_image (p_url in varchar2, p_image IN VARCHAR2);
procedure test;
END XLIB_JASPERREPORTS_IMG;```
## Package Body
```sql
package body xlib_jasperreports_img as
/*
$Id: xlib_jasperreports_img.pkb 71 2017-10-15 16:25:51Z dietmar.aust $
*/
m_module constant varchar2 (100) := $$plsql_unit;
----------------------------------------------------------------------------
-- get_image: retrieves a report image from the server
----------------------------------------------------------------------------
procedure get_image (p_url in varchar2, p_image in varchar2)
is
l_url varchar2 (32767);
l_proc VARCHAR2 (100) := m_module || '.GET_IMAGE';
begin
-------------------------------------------------------
-- construct URL
-------------------------------------------------------
l_url := p_url;
-- use image servlet
l_url := l_url || '_image?image=' || p_image;
-- use images directory /report_tmp/
--l_url := l_url || '_tmp/' || p_image;
-------------------------------------------------------
-- call J2EE server
-------------------------------------------------------
xlog(l_proc, l_url);
xlib_http.display_url_raw (p_url => l_url);
end;
procedure test
is
begin
htp.p('test');
end;
END XLIB_JASPERREPORTS_IMG;```

58
docs/packages/XLIB_LOG.md Normal file
View File

@@ -0,0 +1,58 @@
# XLIB_LOG
## Package Specification
```sql
PACKAGE "XLIB_LOG"
IS
/*=========================================================================
Purpose : Application Logging
License : Copyright (c) 2010 Dietmar Aust (opal-consulting.de)
Licensed under a BSD style license (license.txt)
https://github.com/daust/JasperReportsIntegration
Date Author Comment
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
06.01.2010 D. Aust Initial creation
13.05.2012 D. Aust insert fails when created_by user value too large
=========================================================================*/
PROCEDURE m (
p_module IN VARCHAR2,
p_msg IN VARCHAR2,
p_type IN VARCHAR2 DEFAULT 'DEBUG',
p_level PLS_INTEGER DEFAULT 15
);
END;```
## Package Body
```sql
PACKAGE BODY "XLIB_LOG"
IS
PROCEDURE m (
p_module IN VARCHAR2,
p_msg IN VARCHAR2,
p_type IN VARCHAR2 DEFAULT 'DEBUG',
p_level IN PLS_INTEGER DEFAULT 15
)
IS
PRAGMA AUTONOMOUS_TRANSACTION;
BEGIN
INSERT INTO xlib_logs
(log_module, log_msg, log_type, log_level, log_created_on, log_created_by
)
values ( substr(p_module,1,100)
, substr(p_msg,1,4000)
, substr(p_type,1,20)
, p_level
, sysdate
, substr(nvl(v('APP_USER'), user),1,100)
);
COMMIT;
END;
END;```