diff --git a/.gitignore b/.gitignore index 2eea62f..50c646a 100644 --- a/.gitignore +++ b/.gitignore @@ -25,3 +25,4 @@ vfp/settings.ini vfp/output/ vfp/*.json *.~pck +.claude/HANDOFF.md diff --git a/api/database-scripts/03_pack_json.pck b/api/database-scripts/03_pack_json.pck deleted file mode 100644 index 756374b..0000000 --- a/api/database-scripts/03_pack_json.pck +++ /dev/null @@ -1,561 +0,0 @@ -CREATE OR REPLACE PACKAGE PACK_JSON AS - - -- Tipuri pentru lucrul cu JSON - TYPE t_json_array IS TABLE OF VARCHAR2(4000); - - TYPE t_json_key_value IS RECORD ( - key_name VARCHAR2(100), - key_value VARCHAR2(4000), - key_type VARCHAR2(20) -- 'STRING', 'NUMBER', 'BOOLEAN', 'NULL' - ); - - TYPE t_json_object IS TABLE OF t_json_key_value; - - -- Proprietate pentru tracking erori - g_last_error VARCHAR2(4000); - - -- Functie pentru accesarea ultimei erori - FUNCTION get_last_error RETURN VARCHAR2; - - -- Functie pentru resetarea erorii - PROCEDURE clear_error; - - -- Main parsing functions - FUNCTION parse_array(p_json_array IN CLOB) RETURN t_json_array PIPELINED; -- Parse [{"a":1},{"b":2}] - FUNCTION get_string(p_json_object IN VARCHAR2, p_key_name IN VARCHAR2) RETURN VARCHAR2; -- Get "value" - FUNCTION get_number(p_json_object IN VARCHAR2, p_key_name IN VARCHAR2) RETURN NUMBER; -- Get 123.45 - FUNCTION get_boolean(p_json_object IN VARCHAR2, p_key_name IN VARCHAR2) RETURN BOOLEAN; -- Get true/false - - -- Advanced functions - FUNCTION parse_object(p_json_object IN VARCHAR2) RETURN t_json_object PIPELINED; -- Parse to key-value pairs - FUNCTION clean(p_json IN CLOB) RETURN CLOB; -- Remove whitespace/formatting - - -- Test functions - PROCEDURE run_tests; -- Run all built-in tests - FUNCTION test_basic_parsing RETURN VARCHAR2; -- Test basic JSON parsing - FUNCTION test_array_parsing RETURN VARCHAR2; -- Test array parsing - FUNCTION test_nested_objects RETURN VARCHAR2; -- Test nested JSON structures - FUNCTION test_error_handling RETURN VARCHAR2; -- Test error conditions - -END PACK_JSON; -/ -CREATE OR REPLACE PACKAGE BODY PACK_JSON AS -/* -PACK_JSON - Generic JSON Parser (Oracle 10g/11g/12c compatible) - -USAGE: - -- Parse array: [{"key":"val"},{"key":"val2"}] - FOR obj IN (SELECT * FROM TABLE(PACK_JSON.parse_array(json_clob))) LOOP - v_val := PACK_JSON.get_string(obj.COLUMN_VALUE, 'key'); - END LOOP; - - -- Get values from object: {"name":"John","age":25,"active":true} - v_name := PACK_JSON.get_string(json_obj, 'name'); -- Returns: John - v_age := PACK_JSON.get_number(json_obj, 'age'); -- Returns: 25 - v_active := PACK_JSON.get_boolean(json_obj, 'active'); -- Returns: TRUE - - -- Error handling: - IF PACK_JSON.get_last_error() IS NOT NULL THEN - -- Handle error: PACK_JSON.get_last_error() - PACK_JSON.clear_error(); - END IF; - -FUNCTIONS: - parse_array(clob) - Parse JSON array, returns table of objects - get_string(obj,key) - Extract string value from JSON object - get_number(obj,key) - Extract number value from JSON object - get_boolean(obj,key) - Extract boolean value from JSON object - get_last_error() - Get last parsing error (NULL if no error) - clear_error() - Clear error state -*/ - - -- ================================================================ - -- Functii pentru managementul erorilor - -- ================================================================ - FUNCTION get_last_error RETURN VARCHAR2 IS - BEGIN - RETURN g_last_error; - END get_last_error; - - PROCEDURE clear_error IS - BEGIN - g_last_error := NULL; - END clear_error; - - -- ================================================================ - -- Functie utilitara pentru curatarea JSON - -- ================================================================ - FUNCTION clean( - p_json IN CLOB - ) RETURN CLOB IS - v_clean CLOB; - BEGIN - -- Elimina spatii, tab-uri, newline-uri pentru parsing mai usor - v_clean := REPLACE(REPLACE(REPLACE(REPLACE(p_json, - CHR(10), ''), CHR(13), ''), CHR(9), ''), ' ', ''); - - RETURN v_clean; - END clean; - - -- ================================================================ - -- Parse JSON array si returneaza fiecare obiect - -- ================================================================ - FUNCTION parse_array( - p_json_array IN CLOB - ) RETURN t_json_array PIPELINED IS - - v_json_clean CLOB; - v_articol_json VARCHAR2(4000); - v_start_pos NUMBER := 1; - v_end_pos NUMBER; - v_bracket_count NUMBER; - - BEGIN - -- Reset error - g_last_error := NULL; - - -- Curata JSON-ul - v_json_clean := clean(p_json_array); - - -- Elimina bracket-urile exterioare [ ] - v_json_clean := TRIM(BOTH '[]' FROM v_json_clean); - - -- Parse fiecare obiect JSON din array - LOOP - -- Gaseste inceputul obiectului JSON { - v_start_pos := INSTR(v_json_clean, '{', v_start_pos); - EXIT WHEN v_start_pos = 0; - - -- Gaseste sfarsitul obiectului JSON } - ia in considerare nested objects - v_bracket_count := 1; - v_end_pos := v_start_pos; - - WHILE v_bracket_count > 0 AND v_end_pos < LENGTH(v_json_clean) LOOP - v_end_pos := v_end_pos + 1; - - IF SUBSTR(v_json_clean, v_end_pos, 1) = '{' THEN - v_bracket_count := v_bracket_count + 1; - ELSIF SUBSTR(v_json_clean, v_end_pos, 1) = '}' THEN - v_bracket_count := v_bracket_count - 1; - END IF; - END LOOP; - - -- Extrage obiectul JSON curent - IF v_bracket_count = 0 THEN - v_articol_json := SUBSTR(v_json_clean, v_start_pos, v_end_pos - v_start_pos + 1); - - - PIPE ROW(v_articol_json); - - -- Trece la urmatorul articol - v_start_pos := v_end_pos + 1; - ELSE - -- JSON malformat - g_last_error := 'JSON malformat - bracket-uri neechilibrate'; - EXIT; - END IF; - END LOOP; - - - EXCEPTION - WHEN OTHERS THEN - g_last_error := 'Eroare la parsing array: ' || SQLERRM; - END parse_array; - - -- ================================================================ - -- Extrage valoare string din obiect JSON - -- ================================================================ - FUNCTION get_string( - p_json_object IN VARCHAR2, - p_key_name IN VARCHAR2 - ) RETURN VARCHAR2 IS - v_result VARCHAR2(4000); - BEGIN - -- Oracle 10g compatible: Extract string values - v_result := REGEXP_SUBSTR(p_json_object, - '"' || p_key_name || '":"[^"]*"'); - IF v_result IS NOT NULL THEN - -- Remove key part and quotes manually - v_result := REGEXP_REPLACE(v_result, '^"' || p_key_name || '":"', ''); - v_result := REGEXP_REPLACE(v_result, '"$', ''); - END IF; - - RETURN v_result; - - EXCEPTION - WHEN OTHERS THEN - g_last_error := 'Eroare la extragere string pentru ' || p_key_name || ': ' || SQLERRM; - RETURN NULL; - END get_string; - - -- ================================================================ - -- Extrage valoare numerica din obiect JSON - -- ================================================================ - FUNCTION get_number( - p_json_object IN VARCHAR2, - p_key_name IN VARCHAR2 - ) RETURN NUMBER IS - v_result_str VARCHAR2(100); - v_result NUMBER; - BEGIN - -- Oracle 10g compatible: Extract number values without subexpressions - -- Pattern: "key_name":123.45 (numeric value direct) - v_result_str := REGEXP_SUBSTR(p_json_object, - '"' || p_key_name || '":[0-9]+\.?[0-9]*'); - IF v_result_str IS NOT NULL THEN - -- Extract just the number part after the colon - v_result_str := REGEXP_SUBSTR(v_result_str, '[0-9]+\.?[0-9]*'); - END IF; - - -- Daca nu gaseste, incearca cu quotes: "key_name":"123.45" - IF v_result_str IS NULL OR LENGTH(TRIM(v_result_str)) = 0 THEN - v_result_str := REGEXP_SUBSTR(p_json_object, - '"' || p_key_name || '":"[0-9]+\.?[0-9]*"'); - IF v_result_str IS NOT NULL THEN - -- Extract number between quotes - v_result_str := REGEXP_SUBSTR(v_result_str, '[0-9]+\.?[0-9]*'); - END IF; - END IF; - - IF v_result_str IS NOT NULL AND LENGTH(TRIM(v_result_str)) > 0 THEN - BEGIN - v_result_str := TRIM(v_result_str); - -- Oracle 10g compatible conversion with NLS independence - v_result := TO_NUMBER(v_result_str, '999999999D999999999', 'NLS_NUMERIC_CHARACTERS=''.,'''); - EXCEPTION - WHEN OTHERS THEN - BEGIN - -- Fallback: try with comma as decimal separator - v_result := TO_NUMBER(REPLACE(v_result_str, '.', ',')); - EXCEPTION - WHEN OTHERS THEN - g_last_error := 'Cannot convert to number: "' || v_result_str || '" for key ' || p_key_name; - v_result := NULL; - END; - END; - END IF; - - RETURN v_result; - - EXCEPTION - WHEN OTHERS THEN - g_last_error := 'Eroare la extragere number pentru ' || p_key_name || ': ' || SQLERRM; - RETURN NULL; - END get_number; - - -- ================================================================ - -- Extrage valoare boolean din obiect JSON - -- ================================================================ - FUNCTION get_boolean( - p_json_object IN VARCHAR2, - p_key_name IN VARCHAR2 - ) RETURN BOOLEAN IS - v_result_str VARCHAR2(100); - BEGIN - -- Oracle 10g compatible: Extract boolean values - v_result_str := REGEXP_SUBSTR(p_json_object, - '"' || p_key_name || '":(true|false)'); - IF v_result_str IS NOT NULL THEN - -- Extract just the boolean value - v_result_str := REGEXP_REPLACE(v_result_str, '^"' || p_key_name || '":', ''); - END IF; - - IF v_result_str = 'true' THEN - RETURN TRUE; - ELSIF v_result_str = 'false' THEN - RETURN FALSE; - ELSE - RETURN NULL; - END IF; - - EXCEPTION - WHEN OTHERS THEN - g_last_error := 'Eroare la extragere boolean pentru ' || p_key_name || ': ' || SQLERRM; - RETURN NULL; - END get_boolean; - - -- ================================================================ - -- Parse complet obiect JSON in structura cheie-valoare - -- ================================================================ - FUNCTION parse_object( - p_json_object IN VARCHAR2 - ) RETURN t_json_object PIPELINED IS - - v_clean_json VARCHAR2(4000); - v_key VARCHAR2(100); - v_value VARCHAR2(4000); - v_result t_json_key_value; - v_pos NUMBER := 1; - v_key_start NUMBER; - v_key_end NUMBER; - v_value_start NUMBER; - v_value_end NUMBER; - - BEGIN - -- Curata JSON-ul si elimina { } - v_clean_json := TRIM(BOTH '{}' FROM REPLACE(p_json_object, ' ', '')); - - -- Parse fiecare pereche key:value - WHILE v_pos < LENGTH(v_clean_json) LOOP - -- Gaseste cheia - v_key_start := INSTR(v_clean_json, '"', v_pos); - EXIT WHEN v_key_start = 0; - - v_key_end := INSTR(v_clean_json, '"', v_key_start + 1); - EXIT WHEN v_key_end = 0; - - v_key := SUBSTR(v_clean_json, v_key_start + 1, v_key_end - v_key_start - 1); - - -- Gaseste valoarea - v_value_start := INSTR(v_clean_json, ':', v_key_end); - EXIT WHEN v_value_start = 0; - v_value_start := v_value_start + 1; - - -- Determina tipul si extrage valoarea - IF SUBSTR(v_clean_json, v_value_start, 1) = '"' THEN - -- String value - v_value_end := INSTR(v_clean_json, '"', v_value_start + 1); - v_value := SUBSTR(v_clean_json, v_value_start + 1, v_value_end - v_value_start - 1); - v_result.key_type := 'STRING'; - v_pos := v_value_end + 1; - ELSE - -- Number, boolean sau null - v_value_end := NVL(INSTR(v_clean_json, ',', v_value_start), LENGTH(v_clean_json) + 1); - v_value := SUBSTR(v_clean_json, v_value_start, v_value_end - v_value_start); - - IF v_value IN ('true', 'false') THEN - v_result.key_type := 'BOOLEAN'; - ELSIF v_value = 'null' THEN - v_result.key_type := 'NULL'; - ELSIF REGEXP_LIKE(v_value, '^[0-9.]+$') THEN - v_result.key_type := 'NUMBER'; - ELSE - v_result.key_type := 'UNKNOWN'; - END IF; - - v_pos := v_value_end + 1; - END IF; - - v_result.key_name := v_key; - v_result.key_value := v_value; - - PIPE ROW(v_result); - END LOOP; - - EXCEPTION - WHEN OTHERS THEN - g_last_error := 'Eroare la parsing obiect: ' || SQLERRM; - END parse_object; - - -- ================================================================ - -- Functii de testare - -- ================================================================ - - FUNCTION test_basic_parsing RETURN VARCHAR2 IS - v_test_json VARCHAR2(1000) := '{"name":"John","age":25,"active":true,"score":98.5}'; - v_name VARCHAR2(100); - v_age NUMBER; - v_active BOOLEAN; - v_score NUMBER; - v_result VARCHAR2(4000) := 'BASIC_PARSING: '; - BEGIN - clear_error(); - - v_name := get_string(v_test_json, 'name'); - v_age := get_number(v_test_json, 'age'); - v_active := get_boolean(v_test_json, 'active'); - v_score := get_number(v_test_json, 'score'); - - -- Validate results - IF v_name = 'John' AND v_age = 25 AND v_active = TRUE AND v_score = 98.5 THEN - v_result := v_result || 'PASS - All values extracted correctly'; - ELSE - v_result := v_result || 'FAIL - Values: name=' || v_name || ', age=' || v_age || ', score=' || v_score; - END IF; - - IF get_last_error() IS NOT NULL THEN - v_result := v_result || ' ERROR: ' || get_last_error(); - END IF; - - RETURN v_result; - EXCEPTION - WHEN OTHERS THEN - RETURN 'BASIC_PARSING: EXCEPTION - ' || SQLERRM; - END test_basic_parsing; - - FUNCTION test_array_parsing RETURN VARCHAR2 IS - v_test_array CLOB := '[{"sku":"PROD1","price":10.5},{"sku":"PROD2","price":25.0}]'; - v_count NUMBER := 0; - v_sku VARCHAR2(100); - v_price NUMBER; - v_result VARCHAR2(4000) := 'ARRAY_PARSING: '; - BEGIN - clear_error(); - - FOR obj IN (SELECT * FROM TABLE(parse_array(v_test_array))) LOOP - v_count := v_count + 1; - v_sku := get_string(obj.COLUMN_VALUE, 'sku'); - v_price := get_number(obj.COLUMN_VALUE, 'price'); - - IF v_count = 1 THEN - IF v_sku != 'PROD1' OR v_price != 10.5 THEN - RETURN v_result || 'FAIL - First object: sku=' || v_sku || ', price=' || v_price; - END IF; - ELSIF v_count = 2 THEN - IF v_sku != 'PROD2' OR v_price != 25.0 THEN - RETURN v_result || 'FAIL - Second object: sku=' || v_sku || ', price=' || v_price; - END IF; - END IF; - END LOOP; - - IF v_count = 2 THEN - v_result := v_result || 'PASS - Parsed ' || v_count || ' objects correctly'; - ELSE - v_result := v_result || 'FAIL - Expected 2 objects, got ' || v_count; - END IF; - - IF get_last_error() IS NOT NULL THEN - v_result := v_result || ' ERROR: ' || get_last_error(); - END IF; - - RETURN v_result; - EXCEPTION - WHEN OTHERS THEN - RETURN 'ARRAY_PARSING: EXCEPTION - ' || SQLERRM; - END test_array_parsing; - - FUNCTION test_nested_objects RETURN VARCHAR2 IS - v_test_nested CLOB := '[{"order":{"id":123,"items":[{"sku":"A1","qty":2}],"total":25.50}},{"order":{"id":124,"items":[{"sku":"B1","qty":1},{"sku":"C1","qty":3}],"total":45.00}}]'; - v_count NUMBER := 0; - v_object VARCHAR2(4000); - v_order_id NUMBER; - v_total NUMBER; - v_result VARCHAR2(4000) := 'NESTED_OBJECTS: '; - v_order_json VARCHAR2(2000); - BEGIN - clear_error(); - - -- Test parsing array cu nested objects - FOR obj IN (SELECT * FROM TABLE(parse_array(v_test_nested))) LOOP - v_count := v_count + 1; - v_object := obj.COLUMN_VALUE; - - -- Extrage nested object "order" (Oracle 10g compatible) - v_order_json := REGEXP_SUBSTR(v_object, '"order":\{[^}]+\}'); - IF v_order_json IS NOT NULL THEN - -- Extract just the object part - v_order_json := REGEXP_REPLACE(v_order_json, '^"order":', ''); - END IF; - IF v_order_json IS NULL THEN - -- Incearca sa gaseasca tot nested object-ul (mai complex) - v_order_json := REGEXP_SUBSTR(v_object, '"order":\{.*\}', 1, 1); - -- Elimina "order": din fata - v_order_json := REGEXP_REPLACE(v_order_json, '^"order":', ''); - END IF; - - IF v_order_json IS NOT NULL THEN - v_order_id := get_number(v_order_json, 'id'); - v_total := get_number(v_order_json, 'total'); - - IF v_count = 1 THEN - IF v_order_id != 123 OR v_total != 25.50 THEN - RETURN v_result || 'FAIL - First nested: id=' || v_order_id || ', total=' || v_total; - END IF; - ELSIF v_count = 2 THEN - IF v_order_id != 124 OR v_total != 45.00 THEN - RETURN v_result || 'FAIL - Second nested: id=' || v_order_id || ', total=' || v_total; - END IF; - END IF; - ELSE - RETURN v_result || 'FAIL - Could not extract nested order object from: ' || SUBSTR(v_object, 1, 100); - END IF; - END LOOP; - - IF v_count = 2 THEN - v_result := v_result || 'PASS - Parsed ' || v_count || ' nested objects correctly'; - ELSE - v_result := v_result || 'FAIL - Expected 2 nested objects, got ' || v_count; - END IF; - - IF get_last_error() IS NOT NULL THEN - v_result := v_result || ' ERROR: ' || get_last_error(); - END IF; - - RETURN v_result; - EXCEPTION - WHEN OTHERS THEN - RETURN 'NESTED_OBJECTS: EXCEPTION - ' || SQLERRM; - END test_nested_objects; - - FUNCTION test_error_handling RETURN VARCHAR2 IS - v_result VARCHAR2(4000) := 'ERROR_HANDLING: '; - v_invalid_json VARCHAR2(1000) := '{"broken":}'; - v_value VARCHAR2(100); - BEGIN - clear_error(); - - -- Force an error by trying to parse malformed array - BEGIN - FOR obj IN (SELECT * FROM TABLE(parse_array('[{"incomplete":"object"'))) LOOP - NULL; - END LOOP; - EXCEPTION - WHEN OTHERS THEN - -- This should trigger parse_array to set g_last_error - NULL; - END; - - -- Alternative: try to get a string from NULL object - v_value := get_string(NULL, 'test'); - - IF get_last_error() IS NOT NULL THEN - v_result := v_result || 'PASS - Error properly captured: ' || SUBSTR(get_last_error(), 1, 100); - clear_error(); - ELSE - v_result := v_result || 'FAIL - No error captured for invalid operations'; - END IF; - - -- Test error clearing - IF get_last_error() IS NULL THEN - v_result := v_result || ' - Error cleared successfully'; - ELSE - v_result := v_result || ' - Error not cleared properly'; - END IF; - - RETURN v_result; - EXCEPTION - WHEN OTHERS THEN - RETURN 'ERROR_HANDLING: EXCEPTION - ' || SQLERRM; - END test_error_handling; - - PROCEDURE run_tests IS - v_test_result VARCHAR2(4000); - BEGIN - DBMS_OUTPUT.PUT_LINE('=== PACK_JSON Test Suite ==='); - DBMS_OUTPUT.PUT_LINE(''); - - -- Test 1: Basic parsing - v_test_result := test_basic_parsing(); - DBMS_OUTPUT.PUT_LINE(v_test_result); - - -- Test 2: Array parsing - v_test_result := test_array_parsing(); - DBMS_OUTPUT.PUT_LINE(v_test_result); - - -- Test 3: Nested objects - v_test_result := test_nested_objects(); - DBMS_OUTPUT.PUT_LINE(v_test_result); - - -- Test 4: Error handling - v_test_result := test_error_handling(); - DBMS_OUTPUT.PUT_LINE(v_test_result); - - DBMS_OUTPUT.PUT_LINE(''); - DBMS_OUTPUT.PUT_LINE('=== Test Suite Complete ==='); - EXCEPTION - WHEN OTHERS THEN - DBMS_OUTPUT.PUT_LINE('ERROR in run_tests: ' || SQLERRM); - END run_tests; - -END PACK_JSON; -/ diff --git a/api/database-scripts/06_pack_import_comenzi.pck b/api/database-scripts/06_pack_import_comenzi.pck index 57664f1..fe75087 100644 --- a/api/database-scripts/06_pack_import_comenzi.pck +++ b/api/database-scripts/06_pack_import_comenzi.pck @@ -1,28 +1,55 @@ +-- ==================================================================== +-- PACK_IMPORT_COMENZI +-- Package pentru importul comenzilor din platforme web (GoMag, etc.) +-- in sistemul ROA Oracle. +-- +-- Dependinte: +-- Packages: PACK_COMENZI (adauga_comanda, adauga_articol_comanda) +-- pljson (pljson_list, pljson) - instalat in CONTAFIN_ORACLE, +-- accesat prin PUBLIC SYNONYM +-- Tabele: ARTICOLE_TERTI (mapari SKU -> CODMAT) +-- NOM_ARTICOLE (nomenclator articole ROA) +-- COMENZI (verificare duplicat comanda_externa) +-- +-- Proceduri publice: +-- +-- importa_comanda(...) +-- Importa o comanda completa: creeaza comanda + adauga articolele. +-- p_json_articole accepta: +-- - array JSON: [{"sku":"X","quantity":"1","price":"10","vat":"19"}, ...] +-- - obiect JSON: {"sku":"X","quantity":"1","price":"10","vat":"19"} +-- Valorile sku, quantity, price, vat sunt extrase ca STRING si convertite. +-- Daca comanda exista deja (comanda_externa), nu se dubleaza. +-- La eroare ridica RAISE_APPLICATION_ERROR(-20001, mesaj). +-- Returneaza v_id_comanda (OUT) = ID-ul comenzii create. +-- +-- Logica cautare articol per SKU: +-- 1. Mapari speciale din ARTICOLE_TERTI (reimpachetare, seturi compuse) +-- - un SKU poate avea mai multe randuri (set) cu procent_pret +-- 2. Fallback: cautare directa in NOM_ARTICOLE dupa CODMAT = SKU +-- +-- get_last_error / clear_error +-- Management erori pentru orchestratorul VFP. +-- +-- Exemplu utilizare: +-- DECLARE +-- v_id NUMBER; +-- BEGIN +-- PACK_IMPORT_COMENZI.importa_comanda( +-- p_nr_comanda_ext => '479317993', +-- p_data_comanda => SYSDATE, +-- p_id_partener => 1424, +-- p_json_articole => '[{"sku":"5941623003366","quantity":"1.00","price":"40.99","vat":"21"}]', +-- p_id_pol => 39, +-- v_id_comanda => v_id); +-- DBMS_OUTPUT.PUT_LINE('ID comanda: ' || v_id); +-- END; +-- ==================================================================== CREATE OR REPLACE PACKAGE PACK_IMPORT_COMENZI AS - -- Tipuri pentru returnarea rezultatelor - TYPE t_articol_result IS RECORD( - id_articol NUMBER, - codmat VARCHAR2(50), - cantitate_roa NUMBER, - pret_unitar NUMBER, - ptva NUMBER, - success NUMBER, - error_message VARCHAR2(4000)); - - TYPE t_articol_table IS TABLE OF t_articol_result; - -- Variabila package pentru ultima eroare (pentru orchestrator VFP) g_last_error VARCHAR2(4000); - -- Functie pentru gasirea/maparea articolelor ROA - FUNCTION gaseste_articol_roa(p_sku IN VARCHAR2, - p_pret_web IN NUMBER DEFAULT NULL, - p_cantitate_web IN NUMBER DEFAULT 1, - p_ptva IN NUMBER) - RETURN t_articol_table - PIPELINED; - -- Procedura pentru importul complet al unei comenzi PROCEDURE importa_comanda(p_nr_comanda_ext IN VARCHAR2, p_data_comanda IN DATE, @@ -34,7 +61,7 @@ CREATE OR REPLACE PACKAGE PACK_IMPORT_COMENZI AS p_id_sectie IN NUMBER DEFAULT NULL, v_id_comanda OUT NUMBER); - -- Functii pentru managementul erorilor (similar cu PACK_JSON) + -- Functii pentru managementul erorilor (pentru orchestrator VFP) FUNCTION get_last_error RETURN VARCHAR2; PROCEDURE clear_error; @@ -43,7 +70,6 @@ END PACK_IMPORT_COMENZI; CREATE OR REPLACE PACKAGE BODY PACK_IMPORT_COMENZI AS -- Constante pentru configurare - -- Nota: c_id_pol, c_id_gestiune, c_id_sectie sunt acum parametri ai procedurii importa_comanda c_id_util CONSTANT NUMBER := -3; -- Sistem c_interna CONSTANT NUMBER := 2; -- Comenzi de la client (web) @@ -61,155 +87,7 @@ CREATE OR REPLACE PACKAGE BODY PACK_IMPORT_COMENZI AS END clear_error; -- ================================================================ - -- Functii interne - -- ================================================================ - - -- Procedura interna pentru validarea seturilor - FUNCTION valideaza_set(p_sku IN VARCHAR2) RETURN BOOLEAN IS - v_suma_procent NUMBER := 0; - v_count_articole NUMBER := 0; - BEGIN - SELECT NVL(SUM(procent_pret), 0), COUNT(*) - INTO v_suma_procent, v_count_articole - FROM articole_terti - WHERE sku = p_sku - AND activ = 1; - - -- Validari logice pentru seturi - IF v_count_articole > 1 THEN - -- Set compus - suma procentelor trebuie sa fie intre 95-105% (toleranta) - IF v_suma_procent < 95 OR v_suma_procent > 105 THEN - -- pINFO('WARN VALIDEAZA_SET ' || p_sku || ': Suma procente nelogica: ' || v_suma_procent || '%', 'IMPORT_COMENZI'); - RETURN FALSE; - END IF; - ELSIF v_count_articole = 1 THEN - -- Reimpachetare - procentul trebuie sa fie 100% - IF v_suma_procent != 100 THEN - -- pINFO('WARN VALIDEAZA_SET ' || p_sku || ': Reimpachetare cu procent != 100%: ' || v_suma_procent || '%', 'IMPORT_COMENZI'); - RETURN FALSE; - END IF; - END IF; - - RETURN TRUE; - END valideaza_set; - - -- ================================================================ - -- Functia principala pentru gasirea articolelor ROA - -- ================================================================ - FUNCTION gaseste_articol_roa(p_sku IN VARCHAR2, - p_pret_web IN NUMBER DEFAULT NULL, - p_cantitate_web IN NUMBER DEFAULT 1, - p_ptva IN NUMBER) - RETURN t_articol_table - PIPELINED IS - - v_result t_articol_result; - v_found_mapping BOOLEAN := FALSE; - - -- Cursor pentru maparile din ARTICOLE_TERTI - CURSOR c_mapari IS - SELECT at.codmat, at.cantitate_roa, at.procent_pret, na.id_articol - FROM articole_terti at - JOIN nom_articole na - ON na.codmat = at.codmat - WHERE at.sku = p_sku - AND at.activ = 1 - ORDER BY at.procent_pret DESC; -- Articolele principale primul - - BEGIN - -- pINFO('GASESTE_ARTICOL ' || p_sku || ': Cautare articol pentru SKU: ' || p_sku, 'IMPORT_COMENZI'); - - -- Initializare rezultat - v_result.success := 0; - v_result.error_message := NULL; - - -- STEP 1: Verifica maparile speciale din ARTICOLE_TERTI - FOR rec IN c_mapari LOOP - v_found_mapping := TRUE; - - v_result.id_articol := rec.id_articol; - v_result.codmat := rec.codmat; - v_result.cantitate_roa := rec.cantitate_roa * p_cantitate_web; - - -- Calculeaza pretul unitar pe baza procentului alocat - IF p_pret_web IS NOT NULL THEN - v_result.pret_unitar := (p_pret_web * rec.procent_pret / 100) / - rec.cantitate_roa; - ELSE - -- Fara pret web, setam 0 (va fi necesar sa fie furnizat) - v_result.pret_unitar := 0; - END IF; - - v_result.ptva := p_ptva; - - v_result.success := 1; - - -- pINFO('GASESTE_ARTICOL ' || p_sku || ': Mapare gasita: ' || rec.codmat || - -- ', Cant: ' || v_result.cantitate_roa || - -- ', Pret: ' || v_result.pret_unitar, 'IMPORT_COMENZI'); - - PIPE ROW(v_result); - END LOOP; - - -- STEP 2: Daca nu s-au gasit mapari speciale, cauta direct in nom_articole - IF NOT v_found_mapping THEN - BEGIN - SELECT id_articol, codmat - INTO v_result.id_articol, v_result.codmat - FROM nom_articole - WHERE codmat = p_sku; - - v_result.cantitate_roa := p_cantitate_web; - - -- Pentru cautare directa, foloseste pretul din web daca este furnizat - IF p_pret_web IS NOT NULL THEN - v_result.pret_unitar := p_pret_web; - END IF; - - v_result.ptva := p_ptva; - - v_result.success := 1; - - -- pINFO('GASESTE_ARTICOL ' || p_sku || ': Gasit direct in nomenclator: ' || v_result.codmat, 'IMPORT_COMENZI'); - - PIPE ROW(v_result); - - EXCEPTION - WHEN NO_DATA_FOUND THEN - v_result.success := 0; - v_result.error_message := 'SKU nu a fost gasit nici in ARTICOLE_TERTI, nici in nom_articole: ' || - p_sku; - - -- pINFO('ERROR GASESTE_ARTICOL ' || p_sku || ': ' || v_result.error_message, 'IMPORT_COMENZI'); - PIPE ROW(v_result); - - WHEN TOO_MANY_ROWS THEN - v_result.success := 0; - v_result.error_message := 'Multiple articole gasite pentru SKU: ' || - p_sku; - - -- pINFO('ERROR GASESTE_ARTICOL ' || p_sku || ': ' || v_result.error_message, 'IMPORT_COMENZI'); - PIPE ROW(v_result); - END; - ELSE - -- Valideaza seturile dupa ce au fost returnate toate maparile - IF NOT valideaza_set(p_sku) THEN - null; - -- pINFO('WARN GASESTE_ARTICOL ' || p_sku || ': Set cu configuratie suspecta - verifica procentele', 'IMPORT_COMENZI'); - END IF; - END IF; - - EXCEPTION - WHEN OTHERS THEN - v_result.success := 0; - v_result.error_message := 'Eroare neasteptata: ' || SQLERRM; - - -- pINFO('ERROR GASESTE_ARTICOL ' || p_sku || ': Eroare neasteptata: ' || SQLERRM, 'IMPORT_COMENZI'); - PIPE ROW(v_result); - END gaseste_articol_roa; - - -- ================================================================ - -- Functia pentru importul complet al unei comenzi + -- Procedura principala pentru importul unei comenzi -- ================================================================ PROCEDURE importa_comanda(p_nr_comanda_ext IN VARCHAR2, p_data_comanda IN DATE, @@ -224,32 +102,33 @@ CREATE OR REPLACE PACKAGE BODY PACK_IMPORT_COMENZI AS v_sku VARCHAR2(100); v_cantitate_web NUMBER; v_pret_web NUMBER; + v_vat NUMBER; v_articole_procesate NUMBER := 0; v_articole_eroare NUMBER := 0; - v_start_time DATE; - v_vat NUMBER; - - v_articol_json VARCHAR2(4000); - v_articol_count NUMBER := 0; - - v_articole_table t_articol_table; - v_articol_idx NUMBER; - art_rec t_articol_result; - - l_json_articole CLOB := p_json_articole; + v_articol_count NUMBER := 0; + + -- Variabile pentru cautare articol + v_found_mapping BOOLEAN; + v_id_articol NUMBER; + v_codmat VARCHAR2(50); + v_cantitate_roa NUMBER; + v_pret_unitar NUMBER; + + -- pljson + l_json_articole CLOB := p_json_articole; + v_json_arr pljson_list; + v_json_obj pljson; BEGIN - v_start_time := SYSDATE; - -- Resetare eroare la inceputul procesarii clear_error; - + -- Validari de baza IF p_nr_comanda_ext IS NULL OR p_id_partener IS NULL THEN g_last_error := 'IMPORTA_COMANDA ' || NVL(p_nr_comanda_ext, 'NULL') || ': Parametri obligatorii lipsa'; GOTO SFARSIT; END IF; - + -- Verifica daca comanda nu exista deja BEGIN SELECT id_comanda @@ -257,142 +136,146 @@ CREATE OR REPLACE PACKAGE BODY PACK_IMPORT_COMENZI AS FROM comenzi WHERE comanda_externa = p_nr_comanda_ext AND sters = 0; - - -- pINFO('WARN IMPORTA_COMANDA ' || p_nr_comanda_ext || ': Comanda exista deja cu ID: ' || v_id_comanda, 'IMPORT_COMENZI'); - if v_id_comanda is not null then + + IF v_id_comanda IS NOT NULL THEN GOTO sfarsit; - end if; + END IF; EXCEPTION WHEN NO_DATA_FOUND THEN NULL; -- Normal, comanda nu exista END; - + -- Calculeaza data de livrare (comanda + 1 zi) v_data_livrare := p_data_comanda + 1; - - -- STEP 1: Creeaza comanda folosind versiunea overloaded cu OUT parameter - -- Apeleaza procedura adauga_comanda care returneaza ID_COMANDA prin OUT + + -- STEP 1: Creeaza comanda PACK_COMENZI.adauga_comanda(V_NR_COMANDA => p_nr_comanda_ext, V_DATA_COMANDA => p_data_comanda, - V_ID => p_id_partener, -- ID_PART + V_ID => p_id_partener, V_DATA_LIVRARE => v_data_livrare, - V_PROC_DISCOUNT => 0, -- Fara discount implicit + V_PROC_DISCOUNT => 0, V_INTERNA => c_interna, V_ID_UTIL => c_id_util, V_ID_SECTIE => p_id_sectie, V_ID_ADRESA_FACTURARE => p_id_adresa_facturare, V_ID_ADRESA_LIVRARE => p_id_adresa_livrare, - V_ID_CODCLIENT => NULL, -- Nu folosim cod client + V_ID_CODCLIENT => NULL, V_COMANDA_EXTERNA => p_nr_comanda_ext, - V_ID_CTR => NULL, -- Nu avem contract - V_ID_COMANDA => v_id_comanda -- OUT parameter cu ID_COMANDA - ); - + V_ID_CTR => NULL, + V_ID_COMANDA => v_id_comanda); + IF v_id_comanda IS NULL OR v_id_comanda <= 0 THEN g_last_error := 'IMPORTA_COMANDA ' || p_nr_comanda_ext || ': PACK_COMENZI.adauga_comanda a returnat ID invalid'; GOTO sfarsit; END IF; - - -- pINFO('IMPORTA_COMANDA ' || p_nr_comanda_ext || ': Comanda creata cu ID: ' || v_id_comanda, 'IMPORT_COMENZI'); - - -- STEP 2: Proceseaza articolele din JSON folosind PACK_JSON - -- Asteapta format JSON: [{"sku":"ABC","cantitate":1,"pret":10.5},{"sku":"DEF","cantitate":2,"pret":20.0}] - - -- Parse JSON array folosind package-ul generic - FOR json_obj IN (SELECT * - FROM TABLE(PACK_JSON.parse_array(l_json_articole))) LOOP + + -- STEP 2: Proceseaza articolele din JSON folosind pljson + -- Suporta atat array "[{...},{...}]" cat si obiect singular "{...}" + IF LTRIM(l_json_articole) LIKE '[%' THEN + v_json_arr := pljson_list(l_json_articole); + ELSE + v_json_arr := pljson_list('[' || l_json_articole || ']'); + END IF; + + FOR i IN 1 .. v_json_arr.count LOOP v_articol_count := v_articol_count + 1; - v_articol_json := json_obj.COLUMN_VALUE; - + v_json_obj := pljson(v_json_arr.get(i)); + BEGIN - -- Extrage datele folosind functiile PACK_JSON - v_sku := PACK_JSON.get_string(v_articol_json, 'sku'); - v_cantitate_web := PACK_JSON.get_number(v_articol_json, 'quantity'); - v_pret_web := PACK_JSON.get_number(v_articol_json, 'price'); - v_vat := PACK_JSON.get_number(v_articol_json, 'vat'); - - -- pINFO('IMPORTA_COMANDA ' || p_nr_comanda_ext || ': Procesez articol ' || v_articol_count || ': ' || v_sku || ', cant: ' || v_cantitate_web || ', pret: ' || v_pret_web, 'IMPORT_COMENZI'); - - -- STEP 3: Gaseste maparile pentru acest SKU - -- Apeleaza functia si stocheaza rezultatele - SELECT * - BULK COLLECT - INTO v_articole_table - FROM TABLE(gaseste_articol_roa(v_sku, - v_pret_web, - v_cantitate_web, - v_vat)); - - -- Itereaza prin rezultate - IF v_articole_table.COUNT > 0 THEN - FOR v_articol_idx IN 1 .. v_articole_table.COUNT LOOP - - art_rec := v_articole_table(v_articol_idx); - - IF art_rec.success = 1 THEN - -- Adauga articolul la comanda - BEGIN - PACK_COMENZI.adauga_articol_comanda(V_ID_COMANDA => v_id_comanda, - V_ID_ARTICOL => art_rec.id_articol, - V_ID_POL => p_id_pol, - V_CANTITATE => art_rec.cantitate_roa, - V_PRET => art_rec.pret_unitar, - V_ID_UTIL => c_id_util, - V_ID_SECTIE => p_id_sectie, - V_PTVA => art_rec.ptva); - - v_articole_procesate := v_articole_procesate + 1; - - -- pINFO('IMPORTA_COMANDA ' || p_nr_comanda_ext || ': Articol adaugat: ' || art_rec.codmat || - -- ', cant: ' || art_rec.cantitate_roa || - -- ', pret: ' || art_rec.pret_unitar, 'IMPORT_COMENZI'); - - EXCEPTION - WHEN OTHERS THEN - v_articole_eroare := v_articole_eroare + 1; - g_last_error := g_last_error || CHR(10) || - 'ERROR IMPORTA_COMANDA ' || - p_nr_comanda_ext || - ': Eroare la adaugare articol ' || - art_rec.codmat || ': ' || SQLERRM; - -- pINFO('ERROR IMPORTA_COMANDA ' || p_nr_comanda_ext || ': Eroare la adaugare articol ' || art_rec.codmat || ': ' || SQLERRM, 'IMPORT_COMENZI'); - END; - ELSE + -- Extrage datele folosind pljson (valorile vin ca string din json magazin web) + v_sku := v_json_obj.get_string('sku'); + v_cantitate_web := TO_NUMBER(v_json_obj.get_string('quantity')); + v_pret_web := TO_NUMBER(v_json_obj.get_string('price')); + v_vat := TO_NUMBER(v_json_obj.get_string('vat')); + + -- STEP 3: Gaseste articolele ROA pentru acest SKU + -- Cauta mai intai in ARTICOLE_TERTI (mapari speciale / seturi) + v_found_mapping := FALSE; + + FOR rec IN (SELECT at.codmat, at.cantitate_roa, at.procent_pret, na.id_articol + FROM articole_terti at + JOIN nom_articole na ON na.codmat = at.codmat + WHERE at.sku = v_sku + AND at.activ = 1 + ORDER BY at.procent_pret DESC) LOOP + + v_found_mapping := TRUE; + v_cantitate_roa := rec.cantitate_roa * v_cantitate_web; + v_pret_unitar := CASE WHEN v_pret_web IS NOT NULL + THEN (v_pret_web * rec.procent_pret / 100) / rec.cantitate_roa + ELSE 0 + END; + + BEGIN + PACK_COMENZI.adauga_articol_comanda(V_ID_COMANDA => v_id_comanda, + V_ID_ARTICOL => rec.id_articol, + V_ID_POL => p_id_pol, + V_CANTITATE => v_cantitate_roa, + V_PRET => v_pret_unitar, + V_ID_UTIL => c_id_util, + V_ID_SECTIE => p_id_sectie, + V_PTVA => v_vat); + v_articole_procesate := v_articole_procesate + 1; + EXCEPTION + WHEN OTHERS THEN v_articole_eroare := v_articole_eroare + 1; - g_last_error := g_last_error || CHR(10) || - 'ERROR IMPORTA_COMANDA ' || - p_nr_comanda_ext || - ': SKU nu a putut fi mapat: ' || v_sku || - ' - ' || art_rec.error_message; - -- pINFO('ERROR IMPORTA_COMANDA ' || p_nr_comanda_ext || ': SKU nu a putut fi mapat: ' || v_sku || ' - ' || art_rec.error_message, 'IMPORT_COMENZI'); - END IF; - - END LOOP; -- End v_articol_idx loop - ELSE - v_articole_eroare := v_articole_eroare + 1; - g_last_error := g_last_error || CHR(10) || - 'WARN IMPORTA_COMANDA ' || p_nr_comanda_ext || - ': Niciun articol gasit pentru SKU: ' || - v_sku; - -- pINFO('WARN IMPORTA_COMANDA ' || p_nr_comanda_ext || ': Niciun articol gasit pentru SKU: ' || v_sku, 'IMPORT_COMENZI'); + g_last_error := g_last_error || CHR(10) || + 'Eroare adaugare articol ' || rec.codmat || ': ' || SQLERRM; + END; + END LOOP; + + -- Daca nu s-a gasit mapare, cauta direct in NOM_ARTICOLE + IF NOT v_found_mapping THEN + BEGIN + SELECT id_articol, codmat + INTO v_id_articol, v_codmat + FROM nom_articole + WHERE codmat = v_sku; + + v_pret_unitar := NVL(v_pret_web, 0); + + PACK_COMENZI.adauga_articol_comanda(V_ID_COMANDA => v_id_comanda, + V_ID_ARTICOL => v_id_articol, + V_ID_POL => p_id_pol, + V_CANTITATE => v_cantitate_web, + V_PRET => v_pret_unitar, + V_ID_UTIL => c_id_util, + V_ID_SECTIE => p_id_sectie, + V_PTVA => v_vat); + v_articole_procesate := v_articole_procesate + 1; + EXCEPTION + WHEN NO_DATA_FOUND THEN + v_articole_eroare := v_articole_eroare + 1; + g_last_error := g_last_error || CHR(10) || + 'SKU negasit in ARTICOLE_TERTI si NOM_ARTICOLE: ' || v_sku; + WHEN TOO_MANY_ROWS THEN + v_articole_eroare := v_articole_eroare + 1; + g_last_error := g_last_error || CHR(10) || + 'Multiple articole gasite pentru SKU: ' || v_sku; + WHEN OTHERS THEN + v_articole_eroare := v_articole_eroare + 1; + g_last_error := g_last_error || CHR(10) || + 'Eroare adaugare articol ' || v_sku || ' (CODMAT: ' || v_codmat || '): ' || SQLERRM; + END; END IF; - END; -- End DECLARE block pentru v_articole_table - + + END; -- End BEGIN block pentru articol individual + END LOOP; - + -- Verifica daca s-au procesat articole cu succes IF v_articole_procesate = 0 THEN g_last_error := g_last_error || CHR(10) || 'IMPORTA_COMANDA ' || p_nr_comanda_ext || ': Niciun articol nu a fost procesat cu succes'; END IF; - + <> IF g_last_error IS NOT NULL THEN RAISE_APPLICATION_ERROR(-20001, g_last_error); END IF; - + END importa_comanda; END PACK_IMPORT_COMENZI; diff --git a/api/database-scripts/co_2026_03_10_02_COMUN_PLJSON.sql b/api/database-scripts/co_2026_03_10_02_COMUN_PLJSON.sql new file mode 100644 index 0000000..8e993d6 --- /dev/null +++ b/api/database-scripts/co_2026_03_10_02_COMUN_PLJSON.sql @@ -0,0 +1,5086 @@ +-- ==================================================================== +-- co_2026_03_10_02_COMUN_PLJSON.sql +-- Instaleaza PL/JSON (minimal core) in schema CONTAFIN_ORACLE +-- cu GRANT EXECUTE si PUBLIC SYNONYM pentru acces din alte scheme +-- +-- Rulare: sqlplus CONTAFIN_ORACLE/password@ROA_ROMFAST @co_2026_03_10_02_COMUN_PLJSON.sql +-- +-- Sursa: https://github.com/pljson/pljson (MIT License) +-- Versiune: 3.7.1 (core minimal - fara addons) +-- Script self-contained - nu necesita fisiere externe +-- ==================================================================== + +SET SERVEROUTPUT ON SIZE UNLIMITED +SET DEFINE OFF +ALTER SESSION SET PLSQL_OPTIMIZE_LEVEL = 2; + +PROMPT; +PROMPT =============================================; +PROMPT PL/JSON - Instalare in CONTAFIN_ORACLE; +PROMPT =============================================; +PROMPT; + +-- ==================================================================== +-- STEP 1: Cleanup - sterge obiectele existente (safe) +-- ==================================================================== +PROMPT [1/6] Cleanup obiecte existente...; + +BEGIN + -- Packages + BEGIN EXECUTE IMMEDIATE 'DROP PACKAGE pljson_parser'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP PACKAGE pljson_printer'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP PACKAGE pljson_ext'; EXCEPTION WHEN OTHERS THEN NULL; END; + -- Public synonyms + BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_list'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_element'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_element_array'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_string'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_number'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_bool'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_null'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_varray'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_narray'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_parser'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_printer'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_ext'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_path_segment'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP PUBLIC SYNONYM pljson_path'; EXCEPTION WHEN OTHERS THEN NULL; END; + -- Types (ordinea conteaza - dependentele ultimele) + BEGIN EXECUTE IMMEDIATE 'DROP TYPE pljson FORCE'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP TYPE pljson_list FORCE'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP TYPE pljson_string FORCE'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP TYPE pljson_number FORCE'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP TYPE pljson_bool FORCE'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP TYPE pljson_null FORCE'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP TYPE pljson_element_array FORCE'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP TYPE pljson_element FORCE'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP TYPE pljson_path_segment FORCE'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP TYPE pljson_path FORCE'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP TYPE pljson_narray FORCE'; EXCEPTION WHEN OTHERS THEN NULL; END; + BEGIN EXECUTE IMMEDIATE 'DROP TYPE pljson_varray FORCE'; EXCEPTION WHEN OTHERS THEN NULL; END; +END; +/ + +-- ==================================================================== +-- STEP 2: Creare tipuri si declaratii (in ordinea dependentelor) +-- ==================================================================== +PROMPT [2/6] Creare tipuri de baza...; + + +-- --- pljson_element.type.decl --- +create or replace type pljson_path_segment as object ( + indx number(32), + name varchar2(4000) +) final +/ + +create or replace type pljson_path as table of pljson_path_segment +/ + +create or replace type pljson_element force as object +( + /* 1 = object, 2 = array, 3 = string, 4 = number, 5 = bool, 6 = null */ + typeval number(1), + mapname varchar2(4000), + mapindx number(32), + object_id number, + + /* not instantiable */ + constructor function pljson_element return self as result, + + member function is_object return boolean, + member function is_array return boolean, + member function is_string return boolean, + member function is_number return boolean, + member function is_bool return boolean, + member function is_null return boolean, + member function get_type return varchar2, + /* should be overriden */ + member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2, + + /* + member methods to remove need for treat() + */ + member function get_string(max_byte_size number default null, max_char_size number default null) return varchar2, + member function get_clob return clob, + member function get_number return number, + /* E.I.Sarmas (github.com/dsnz) 2016-11-03 support for binary_double numbers */ + member function get_double return binary_double, + /* E.I.Sarmas (github.com/dsnz) 2016-11-03 support for binary_double numbers, is_number is still true, extra info */ + /* return true if 'number' is representable by Oracle number */ + /** Private method for internal processing. */ + member function is_number_repr_number return boolean, + /* return true if 'number' is representable by Oracle binary_double */ + /** Private method for internal processing. */ + member function is_number_repr_double return boolean, + member function get_bool return boolean, + + member function count return number, + member function get(pair_name varchar2) return pljson_element, + member function get(position pls_integer) return pljson_element, + + member function path(json_path varchar2, base number default 1) return pljson_element, + + /* output methods */ + member function to_char(spaces boolean default true, chars_per_line number default 0) return varchar2, + member procedure to_clob(self in pljson_element, buf in out nocopy clob, spaces boolean default false, chars_per_line number default 0, erase_clob boolean default true), + member procedure print(self in pljson_element, spaces boolean default true, chars_per_line number default 8192, jsonp varchar2 default null), + member procedure htp(self in pljson_element, spaces boolean default false, chars_per_line number default 0, jsonp varchar2 default null), + + /* private method for internal use, not part of the API, contributed by @asfernandes */ + member procedure get_internal_path(self in pljson_element, path pljson_path, path_position pls_integer, ret out nocopy pljson_element), + + /* private method for internal use, not part of the API, contributed by @asfernandes */ + member function put_internal_path(self in out nocopy pljson_element, path pljson_path, elem pljson_element, path_position pls_integer) return boolean +) not final +/ +show err + +create or replace type pljson_element_array as table of pljson_element +/ + +-- --- pljson_list.type.decl --- +set termout off +create or replace type pljson_varray as table of varchar2(32767); +/ +create or replace type pljson_narray as table of number; +/ + +set termout on +create or replace type pljson_list force under pljson_element ( + + /* + Copyright (c) 2010 Jonas Krogsboell + + Permission is hereby granted, free of charge, to any person obtaining a copy + of this software and associated documentation files (the "Software"), to deal + in the Software without restriction, including without limitation the rights + to use, copy, modify, merge, publish, distribute, sublicense, and/or sell + copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN + THE SOFTWARE. + */ + + /* variables */ + list_data pljson_element_array, + + /* constructors */ + constructor function pljson_list return self as result, + constructor function pljson_list(str varchar2) return self as result, + constructor function pljson_list(str clob) return self as result, + constructor function pljson_list(str blob, charset varchar2 default 'UTF8') return self as result, + constructor function pljson_list(str_array pljson_varray) return self as result, + constructor function pljson_list(num_array pljson_narray) return self as result, + constructor function pljson_list(elem pljson_element) return self as result, + constructor function pljson_list(elem_array pljson_element_array) return self as result, + overriding member function is_array return boolean, + overriding member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2, + + /* list management */ + member procedure append(self in out nocopy pljson_list, elem pljson_element, position pls_integer default null), + member procedure append(self in out nocopy pljson_list, elem varchar2, position pls_integer default null), + member procedure append(self in out nocopy pljson_list, elem clob, position pls_integer default null), + member procedure append(self in out nocopy pljson_list, elem number, position pls_integer default null), + /* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */ + member procedure append(self in out nocopy pljson_list, elem binary_double, position pls_integer default null), + member procedure append(self in out nocopy pljson_list, elem boolean, position pls_integer default null), + member procedure append(self in out nocopy pljson_list, elem pljson_list, position pls_integer default null), + + member procedure replace(self in out nocopy pljson_list, position pls_integer, elem pljson_element), + member procedure replace(self in out nocopy pljson_list, position pls_integer, elem varchar2), + member procedure replace(self in out nocopy pljson_list, position pls_integer, elem clob), + member procedure replace(self in out nocopy pljson_list, position pls_integer, elem number), + /* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */ + member procedure replace(self in out nocopy pljson_list, position pls_integer, elem binary_double), + member procedure replace(self in out nocopy pljson_list, position pls_integer, elem boolean), + member procedure replace(self in out nocopy pljson_list, position pls_integer, elem pljson_list), + + member procedure remove(self in out nocopy pljson_list, position pls_integer), + member procedure remove_first(self in out nocopy pljson_list), + member procedure remove_last(self in out nocopy pljson_list), + + overriding member function count return number, + overriding member function get(position pls_integer) return pljson_element, + member function get_string(position pls_integer) return varchar2, + member function get_clob(position pls_integer) return clob, + member function get_number(position pls_integer) return number, + member function get_double(position pls_integer) return binary_double, + member function get_bool(position pls_integer) return boolean, + member function get_pljson_list(position pls_integer) return pljson_list, + member function head return pljson_element, + member function last return pljson_element, + member function tail return pljson_list, + + /* json path */ + overriding member function path(json_path varchar2, base number default 1) return pljson_element, + /* json path_put */ + member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem pljson_element, base number default 1), + member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem varchar2, base number default 1), + member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem clob, base number default 1), + member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem number, base number default 1), + /* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */ + member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem binary_double, base number default 1), + member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem boolean, base number default 1), + member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem pljson_list, base number default 1), + + /* json path_remove */ + member procedure path_remove(self in out nocopy pljson_list, json_path varchar2, base number default 1), + + /* private method for internal use, not part of the API, contributed by @asfernandes */ + overriding member procedure get_internal_path(self in pljson_list, path pljson_path, path_position pls_integer, ret out nocopy pljson_element), + + /* private method for internal use, not part of the API, contributed by @asfernandes */ + overriding member function put_internal_path(self in out nocopy pljson_list, path pljson_path, elem pljson_element, path_position pls_integer) return boolean +) not final; +/ +show err + +-- --- pljson.type.decl --- +set termout off +create or replace type pljson_varray as table of varchar2(32767); +/ + +set termout on +create or replace type pljson force under pljson_element ( + + /* + Copyright (c) 2010 Jonas Krogsboell + + Permission is hereby granted, free of charge, to any person obtaining a copy + of this software and associated documentation files (the "Software"), to deal + in the Software without restriction, including without limitation the rights + to use, copy, modify, merge, publish, distribute, sublicense, and/or sell + copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN + THE SOFTWARE. + */ + + /* variables */ + json_data pljson_element_array, + check_for_duplicate number, + + /* constructors */ + constructor function pljson return self as result, + constructor function pljson(str varchar2) return self as result, + constructor function pljson(str in clob) return self as result, + constructor function pljson(str in blob, charset varchar2 default 'UTF8') return self as result, + constructor function pljson(str_array pljson_varray) return self as result, + constructor function pljson(elem pljson_element) return self as result, + constructor function pljson(l pljson_list) return self as result, + overriding member function is_object return boolean, + overriding member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2, + + /* member management */ + member procedure remove(pair_name varchar2), + + member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value pljson_element, position pls_integer default null), + member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value varchar2, position pls_integer default null), + member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value clob, position pls_integer default null), + member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value number, position pls_integer default null), + /* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */ + member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value binary_double, position pls_integer default null), + member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value boolean, position pls_integer default null), + + member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value pljson, position pls_integer default null), + member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value pljson_list, position pls_integer default null), + + overriding member function count return number, + overriding member function get(pair_name varchar2) return pljson_element, + + member function get_string(pair_name varchar2) return varchar2, + member function get_clob(pair_name varchar2) return clob, + member function get_number(pair_name varchar2) return number, + member function get_double(pair_name varchar2) return binary_double, + member function get_bool(pair_name varchar2) return boolean, + member function get_pljson(pair_name varchar2) return pljson, + member function get_pljson_list(pair_name varchar2) return pljson_list, + + overriding member function get(position pls_integer) return pljson_element, + member function index_of(pair_name varchar2) return number, + member function exist(pair_name varchar2) return boolean, + + member procedure check_duplicate(self in out nocopy pljson, v_set boolean), + member procedure remove_duplicates(self in out nocopy pljson), + + /* json path */ + overriding member function path(json_path varchar2, base number default 1) return pljson_element, + + /* json path_put */ + member procedure path_put(self in out nocopy pljson, json_path varchar2, elem pljson_element, base number default 1), + member procedure path_put(self in out nocopy pljson, json_path varchar2, elem varchar2, base number default 1), + member procedure path_put(self in out nocopy pljson, json_path varchar2, elem clob, base number default 1), + member procedure path_put(self in out nocopy pljson, json_path varchar2, elem number, base number default 1), + /* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */ + member procedure path_put(self in out nocopy pljson, json_path varchar2, elem binary_double, base number default 1), + member procedure path_put(self in out nocopy pljson, json_path varchar2, elem boolean, base number default 1), + member procedure path_put(self in out nocopy pljson, json_path varchar2, elem pljson, base number default 1), + member procedure path_put(self in out nocopy pljson, json_path varchar2, elem pljson_list, base number default 1), + + /* json path_remove */ + member procedure path_remove(self in out nocopy pljson, json_path varchar2, base number default 1), + + /* map functions */ + member function get_keys return pljson_list, + member function get_values return pljson_list, + + /* private method for internal use, not part of the API, contributed by @asfernandes */ + overriding member procedure get_internal_path(self in pljson, path pljson_path, path_position pls_integer, ret out nocopy pljson_element), + + /* private method for internal use, not part of the API, contributed by @asfernandes */ + overriding member function put_internal_path(self in out nocopy pljson, path pljson_path, elem pljson_element, path_position pls_integer) return boolean +) not final; +/ +show err + +-- --- pljson_string.type (spec + body) --- +create or replace type pljson_string force under pljson_element ( + + num number, + str varchar2(32767), + extended_str clob, + unescaped_string_delim_p number, -- 0/1 for false/true + unescaped_string_delim varchar2(10), + + constructor function pljson_string(str varchar2, esc boolean default true, + unescaped_string_delim_p boolean default false, unescaped_string_delim varchar2 default '') return self as result, + constructor function pljson_string(str clob, esc boolean default true, + unescaped_string_delim_p boolean default false, unescaped_string_delim varchar2 default '') return self as result, + overriding member function is_string return boolean, + overriding member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2, + + overriding member function get_string(max_byte_size number default null, max_char_size number default null) return varchar2, + overriding member function get_clob return clob + /* + member procedure get_string(buf in out nocopy clob) + */ +) not final +/ +show err + +create or replace type body pljson_string as + + constructor function pljson_string(str varchar2, esc boolean default true, + unescaped_string_delim_p boolean default false, unescaped_string_delim varchar2 default '') return self as result as + begin + self.typeval := 3; + if (esc) then self.num := 1; else self.num := 0; end if; --message to pretty printer + self.str := str; + -- unescaped string delimiter + self.unescaped_string_delim_p := 0; + if unescaped_string_delim_p then + self.unescaped_string_delim_p := 1; + self.unescaped_string_delim := unescaped_string_delim; + end if; + return; + end; + + constructor function pljson_string(str clob, esc boolean default true, + unescaped_string_delim_p boolean default false, unescaped_string_delim varchar2 default '') return self as result as + /* E.I.Sarmas (github.com/dsnz) 2016-01-21 limit to 5000 chars */ + /* for Unicode text, varchar2 'self.str' not exceed 5000 chars, does not limit size of data */ + max_string_chars number := 5000; /* chunk size, less than this number may be copied */ + lengthcc number; + begin + self.typeval := 3; + if (esc) then self.num := 1; else self.num := 0; end if; --message to pretty printer + -- lengthcc := pljson_parser.lengthcc(str); + -- if lengthcc > max_string_chars then + /* not so accurate, may be less than "max_string_chars" */ + /* it's not absolute restricting limit and it's faster than using lengthcc */ + if (dbms_lob.getlength(str) > max_string_chars) then + self.extended_str := str; + end if; + -- GHS 20120615: Added IF structure to handle null clobs + if dbms_lob.getlength(str) > 0 then + /* may read less than "max_string_chars" characters but it's a sample so doesn't matter */ + dbms_lob.read(str, max_string_chars, 1, self.str); + end if; + -- unescaped string delimiter + self.unescaped_string_delim_p := 0; + if unescaped_string_delim_p then + self.unescaped_string_delim_p := 1; + self.unescaped_string_delim := unescaped_string_delim; + end if; + return; + end; + + overriding member function is_string return boolean as + begin + return true; + end; + + overriding member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2 as + begin + return get_string(max_byte_size, max_char_size); + end; + + overriding member function get_string(max_byte_size number default null, max_char_size number default null) return varchar2 as + begin + if (max_byte_size is not null) then + return substrb(self.str, 1, max_byte_size); + elsif (max_char_size is not null) then + return substr(self.str, 1, max_char_size); + else + return self.str; + end if; + end; + + overriding member function get_clob return clob as + begin + if (extended_str is not null) then + --dbms_lob.copy(buf, extended_str, dbms_lob.getlength(extended_str)); + return self.extended_str; + else + /* writeappend works with length2() value */ + --dbms_lob.writeappend(buf, length2(self.str), self.str); + return self.str; + end if; + end; + + /* + member procedure get_string(buf in out nocopy clob) as + begin + dbms_lob.trim(buf, 0); + if (extended_str is not null) then + dbms_lob.copy(buf, extended_str, dbms_lob.getlength(extended_str)); + else + -- writeappend works with length2() value + dbms_lob.writeappend(buf, length2(self.str), self.str); + end if; + end; + */ +end; +/ +show err + +-- --- pljson_number.type (spec + body) --- +create or replace type pljson_number force under pljson_element +( + num number, + num_double binary_double, -- both num and num_double are set, there is never exception (until Oracle 12c) + num_repr_number_p varchar2(1), + num_repr_double_p varchar2(1), + + constructor function pljson_number(num number) return self as result, + /* E.I.Sarmas (github.com/dsnz) 2016-11-03 support for binary_double numbers */ + constructor function pljson_number(num_double binary_double) return self as result, + overriding member function is_number return boolean, + overriding member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2, + + overriding member function get_number return number, + /* E.I.Sarmas (github.com/dsnz) 2016-11-03 support for binary_double numbers */ + overriding member function get_double return binary_double, + + /* E.I.Sarmas (github.com/dsnz) 2016-11-03 support for binary_double numbers, is_number is still true, extra info */ + /* return true if 'number' is representable by Oracle number */ + /** Private method for internal processing. */ + overriding member function is_number_repr_number return boolean, + /* return true if 'number' is representable by Oracle binary_double */ + /** Private method for internal processing. */ + overriding member function is_number_repr_double return boolean, + /* E.I.Sarmas (github.com/dsnz) 2016-11-03 support for binary_double numbers */ + -- set value for number from string representation; to replace to_number in pljson_parser + -- can automatically decide and use binary_double if needed + -- less confusing than new constructor with dummy argument for overloading + -- centralized parse_number to use everywhere else and replace code in pljson_parser + -- this procedure is meant to be used internally only + -- procedure does not work correctly if called standalone in locales that + -- use a character other than "." for decimal point + member procedure parse_number(str varchar2), + + /* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */ + -- this procedure is meant to be used internally only + member function number_toString return varchar2 +) not final +/ +show err + +create or replace type body pljson_number as + + constructor function pljson_number(num number) return self as result as + begin + self.typeval := 4; + self.num := nvl(num, 0); + /* E.I.Sarmas (github.com/dsnz) 2016-11-03 support for binary_double numbers; typeval not changed, it is still json number */ + self.num_repr_number_p := 't'; + self.num_double := num; + if (to_number(self.num_double) = self.num) then + self.num_repr_double_p := 't'; + else + self.num_repr_double_p := 'f'; + end if; + return; + end; + + /* E.I.Sarmas (github.com/dsnz) 2016-11-03 support for binary_double numbers; typeval not changed, it is still json number */ + constructor function pljson_number(num_double binary_double) return self as result as + begin + self.typeval := 4; + self.num_double := nvl(num_double, 0); + self.num_repr_double_p := 't'; + self.num := num_double; + if (to_binary_double(self.num) = self.num_double) then + self.num_repr_number_p := 't'; + else + self.num_repr_number_p := 'f'; + end if; + return; + end; + + overriding member function is_number return boolean as + begin + return true; + end; + + overriding member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2 as + begin + return self.num; + end; + + overriding member function get_number return number as + begin + return self.num; + end; + + /* E.I.Sarmas (github.com/dsnz) 2016-11-03 support for binary_double numbers */ + overriding member function get_double return binary_double as + begin + return self.num_double; + end; + + /* E.I.Sarmas (github.com/dsnz) 2016-11-03 support for binary_double numbers, is_number is still true, extra check */ + /* return true if 'number' is representable by Oracle number */ + overriding member function is_number_repr_number return boolean is + begin + return (num_repr_number_p = 't'); + end; + + /* return true if 'number' is representable by Oracle binary_double */ + overriding member function is_number_repr_double return boolean is + begin + return (num_repr_double_p = 't'); + end; + + /* E.I.Sarmas (github.com/dsnz) 2016-11-03 support for binary_double numbers */ + -- set value for number from string representation; to replace to_number in pljson_parser + -- can automatically decide and use binary_double if needed (set repr variables) + -- underflows and overflows count as representable if happen on both type representations + -- less confusing than new constructor with dummy argument for overloading + -- centralized parse_number to use everywhere else and replace code in pljson_parser + -- + -- WARNING: + -- + -- procedure does not work correctly if called standalone in locales that + -- use a character other than "." for decimal point + -- + -- parse_number() is intended to be used inside pljson_parser which + -- uses session NLS_PARAMETERS to get decimal point and + -- changes "." to this decimal point before calling parse_number() + -- + member procedure parse_number(str varchar2) is + begin + self.num := to_number(str); + self.num_repr_number_p := 't'; + self.num_double := to_binary_double(str); + self.num_repr_double_p := 't'; + if (to_binary_double(self.num) != self.num_double) then + self.num_repr_number_p := 'f'; + end if; + if (to_number(self.num_double) != self.num) then + self.num_repr_double_p := 'f'; + end if; + end parse_number; + + /* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */ + -- centralized toString to use everywhere else and replace code in pljson_printer + member function number_toString return varchar2 is + num number; + num_double binary_double; + buf varchar2(4000); + begin + /* unrolled, instead of using two nested fuctions for speed */ + if (self.num_repr_number_p = 't') then + num := self.num; + if (num > 1e127d) then + return '1e309'; -- json representation of infinity !? + end if; + if (num < -1e127d) then + return '-1e309'; -- json representation of infinity !? + end if; + buf := STANDARD.to_char(num, 'TM9', 'NLS_NUMERIC_CHARACTERS=''.,'''); + if (-1 < num and num < 0 and substr(buf, 1, 2) = '-.') then + buf := '-0' || substr(buf, 2); + elsif (0 < num and num < 1 and substr(buf, 1, 1) = '.') then + buf := '0' || buf; + end if; + return buf; + else + num_double := self.num_double; + if (num_double = +BINARY_DOUBLE_INFINITY) then + return '1e309'; -- json representation of infinity !? + end if; + if (num_double = -BINARY_DOUBLE_INFINITY) then + return '-1e309'; -- json representation of infinity !? + end if; + buf := STANDARD.to_char(num_double, 'TM9', 'NLS_NUMERIC_CHARACTERS=''.,'''); + if (-1 < num_double and num_double < 0 and substr(buf, 1, 2) = '-.') then + buf := '-0' || substr(buf, 2); + elsif (0 < num_double and num_double < 1 and substr(buf, 1, 1) = '.') then + buf := '0' || buf; + end if; + return buf; + end if; + end number_toString; +end; +/ +show err + +-- --- pljson_bool.type (spec + body) --- +create or replace type pljson_bool force under pljson_element ( + + num number(1), + + constructor function pljson_bool (b in boolean) return self as result, + overriding member function is_bool return boolean, + overriding member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2, + + overriding member function get_bool return boolean +) not final +/ +show err + +create or replace type body pljson_bool as + + constructor function pljson_bool (b in boolean) return self as result as + begin + self.typeval := 5; + self.num := 0; + if b then self.num := 1; end if; + return; + end; + + overriding member function is_bool return boolean as + begin + return true; + end; + + overriding member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2 as + begin + if self.num = 1 then return 'true'; else return 'false'; end if; + end; + + overriding member function get_bool return boolean as + begin + return self.num = 1; + end; +end; +/ +show err + +-- --- pljson_null.type (spec + body) --- +create or replace type pljson_null force under pljson_element +( + constructor function pljson_null return self as result, + overriding member function is_null return boolean, + overriding member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2 +) not final +/ +show err + +create or replace type body pljson_null as + + constructor function pljson_null return self as result as + begin + self.typeval := 6; + return; + end; + + overriding member function is_null return boolean as + begin + return true; + end; + + overriding member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2 as + begin + return 'null'; + end; +end; +/ +show err + +-- ==================================================================== +-- STEP 3: Creare package specs +-- ==================================================================== +PROMPT [3/6] Creare package specifications...; + + +-- --- pljson_ext.decl --- +create or replace package pljson_ext as + /* + Copyright (c) 2009 Jonas Krogsboell + + Permission is hereby granted, free of charge, to any person obtaining a copy + of this software and associated documentation files (the "Software"), to deal + in the Software without restriction, including without limitation the rights + to use, copy, modify, merge, publish, distribute, sublicense, and/or sell + copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN + THE SOFTWARE. + */ + + /* This package contains extra methods to lookup types and + an easy way of adding date values in json - without changing the structure */ + function parsePath(json_path varchar2, base number default 1) return pljson_list; + + --JSON pre-parsed path getters + function get_json_element(obj pljson, path pljson_list) return pljson_element; + function get_string(obj pljson, path pljson_list) return varchar2; + function get_number(obj pljson, path pljson_list) return number; + function get_double(obj pljson, path pljson_list) return binary_double; + function get_json(obj pljson, path pljson_list) return pljson; + function get_json_list(obj pljson, path pljson_list) return pljson_list; + function get_bool(obj pljson, path pljson_list) return boolean; + function get_date(obj pljson, path pljson_list) return date; + + --saved original code, in case of future bug troubleshooting + function get_json_element_original(obj pljson, v_path varchar2, base number default 1) return pljson_element; + + --JSON Path getters + function get_json_element(obj pljson, v_path varchar2, base number default 1) return pljson_element; + function get_string(obj pljson, path varchar2, base number default 1) return varchar2; + function get_number(obj pljson, path varchar2, base number default 1) return number; + function get_double(obj pljson, path varchar2, base number default 1) return binary_double; + function get_json(obj pljson, path varchar2, base number default 1) return pljson; + function get_json_list(obj pljson, path varchar2, base number default 1) return pljson_list; + function get_bool(obj pljson, path varchar2, base number default 1) return boolean; + + --JSON pre-parsed path putters + procedure put(obj in out nocopy pljson, path pljson_list, elem varchar2); + procedure put(obj in out nocopy pljson, path pljson_list, elem number); + procedure put(obj in out nocopy pljson, path pljson_list, elem binary_double); + procedure put(obj in out nocopy pljson, path pljson_list, elem pljson); + procedure put(obj in out nocopy pljson, path pljson_list, elem pljson_list); + procedure put(obj in out nocopy pljson, path pljson_list, elem boolean); + procedure put(obj in out nocopy pljson, path pljson_list, elem pljson_element); + procedure put(obj in out nocopy pljson, path pljson_list, elem date); + + --JSON Path putters + procedure put(obj in out nocopy pljson, path varchar2, elem varchar2, base number default 1); + procedure put(obj in out nocopy pljson, path varchar2, elem number, base number default 1); + procedure put(obj in out nocopy pljson, path varchar2, elem binary_double, base number default 1); + procedure put(obj in out nocopy pljson, path varchar2, elem pljson, base number default 1); + procedure put(obj in out nocopy pljson, path varchar2, elem pljson_list, base number default 1); + procedure put(obj in out nocopy pljson, path varchar2, elem boolean, base number default 1); + procedure put(obj in out nocopy pljson, path varchar2, elem pljson_element, base number default 1); + + procedure remove(obj in out nocopy pljson, path pljson_list); + procedure remove(obj in out nocopy pljson, path varchar2, base number default 1); + + --Pretty print with JSON Path - obsolete in 0.9.4 - obj.path(v_path).(to_char,print,htp) + function pp(obj pljson, v_path varchar2) return varchar2; + procedure pp(obj pljson, v_path varchar2); --using dbms_output.put_line + procedure pp_htp(obj pljson, v_path varchar2); --using htp.print + + --extra function checks if number has no fraction + function is_integer(v pljson_element) return boolean; + + format_string varchar2(30 char) := 'yyyy-mm-dd hh24:mi:ss'; + --extension enables json to store dates without compromising the implementation + function to_json_string(d date) return pljson_string; + --notice that a date type in json is also a varchar2 + function is_date(v pljson_element) return boolean; + --conversion is needed to extract dates + function to_date(v pljson_element) return date; + -- alias so that old code doesn't break + function to_date2(v pljson_element) return date; + --JSON Path with date + function get_date(obj pljson, path varchar2, base number default 1) return date; + procedure put(obj in out nocopy pljson, path varchar2, elem date, base number default 1); + + /* + encoding in lines of 64 chars ending with CR+NL + */ + function encodeBase64Blob2Clob(p_blob in blob) return clob; + /* + assumes single base64 string or broken into equal length lines of max 64 or 76 chars + (as specified by RFC-1421 or RFC-2045) + line ending can be CR+NL or NL + */ + function decodeBase64Clob2Blob(p_clob clob) return blob; + + function base64(binarydata blob) return pljson_list; + function base64(l pljson_list) return blob; + + function encode(binarydata blob) return pljson_string; + function decode(v pljson_string) return blob; + + /* + implemented as a procedure to force you to declare the CLOB so you can free it later + */ + procedure blob2clob(b blob, c out clob, charset varchar2 default 'UTF8'); +end pljson_ext; +/ +show err + +-- --- pljson_parser.decl --- +create or replace package pljson_parser as + /* + Copyright (c) 2010 Jonas Krogsboell + + Permission is hereby granted, free of charge, to any person obtaining a copy + of this software and associated documentation files (the "Software"), to deal + in the Software without restriction, including without limitation the rights + to use, copy, modify, merge, publish, distribute, sublicense, and/or sell + copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN + THE SOFTWARE. + */ + + /** Internal type for processing. */ + /* scanner tokens: + '{', '}', ',', ':', '[', ']', STRING, NUMBER, TRUE, FALSE, NULL + */ + type rToken IS RECORD ( + type_name VARCHAR2(7), + line PLS_INTEGER, + col PLS_INTEGER, + data VARCHAR2(32767), + data_overflow clob); -- max_string_size + + type lTokens is table of rToken index by pls_integer; + type json_src is record (len number, offset number, offset_chars number, src varchar2(32767), s_clob clob, src_len number, src_array pljson_varray); + + json_strict boolean not null := false; + empty_string_as_null boolean not null := false; + + ucs2_exception EXCEPTION; + pragma exception_init(ucs2_exception, -22831); + + procedure set_buffer_amount(amount pls_integer); + + function lengthcc(buf clob) return number; + + function next_char(indx number, s in out nocopy json_src) return varchar2; + function next_char2(indx number, s in out nocopy json_src, amount number default 1) return varchar2; + function parseObj(tokens lTokens, indx in out nocopy pls_integer) return pljson; + + function prepareClob(buf in clob) return pljson_parser.json_src; + function prepareVarchar2(buf in varchar2) return pljson_parser.json_src; + function lexer(jsrc in out nocopy json_src) return lTokens; + procedure print_token(t rToken); + + /** + *

Primary parsing method. It can parse a JSON object.

+ * + * @return An instance of pljson. + * @throws PARSER_ERROR -20101 when invalid input found. + * @throws SCANNER_ERROR -20100 when lexing fails. + */ + function parser(str varchar2) return pljson; + function parse_list(str varchar2) return pljson_list; + function parse_any(str varchar2) return pljson_element; + function parser(str clob) return pljson; + function parse_list(str clob) return pljson_list; + function parse_any(str clob) return pljson_element; + procedure remove_duplicates(obj in out nocopy pljson); + function get_version return varchar2; + +end pljson_parser; +/ +show err + + +-- ==================================================================== +-- STEP 4: Creare package bodies si type implementations +-- ==================================================================== +PROMPT [4/6] Creare package bodies si type implementations...; + + +-- --- pljson_parser.impl (body) --- +create or replace package body pljson_parser as + /* + Copyright (c) 2009 Jonas Krogsboell + + Permission is hereby granted, free of charge, to any person obtaining a copy + of this software and associated documentation files (the "Software"), to deal + in the Software without restriction, including without limitation the rights + to use, copy, modify, merge, publish, distribute, sublicense, and/or sell + copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN + THE SOFTWARE. + */ + + decimalpoint varchar2(1 char) := '.'; + -- 1. perfomance optimal value (such as any of 200 - 500) for length of part s_clob in set_src_array + -- 2. 4000 byte limitation in select "substr(s.src, level, 1)" in set_src_array + buffer_amount number := 200; + + procedure set_buffer_amount(amount pls_integer) as + begin + if amount > 0 and amount <= 4000 then + buffer_amount := amount; + end if; + end; + + procedure set_src_array(s in out nocopy json_src) as + begin + -- calc length src one time after subtsr clob + s.src_len := length(s.src); + -- get collection of char - faster than substr in loop in pl\sql + -- it is necessary to remember about the limitation varchar2 - 4000 byte + select substr(s.src, level, 1) + bulk collect into s.src_array + from dual + connect by level <= s.src_len; + end; + + function lengthcc(buf clob) return number as + offset number := 0; + len number := 0; + src varchar2(32767); + begin + while true loop + begin + src := dbms_lob.substr(buf, buffer_amount, offset+1); + exception + when ucs2_exception then + src := dbms_lob.substr(buf, buffer_amount-1, offset+1); + end; + exit when src is null; + len := len + length(src); + offset := offset + length2(src); + --dbms_output.put_line('offset = ' || offset || ' len = ' || len); + end loop; + return len; + end; + + procedure update_decimalpoint as + begin + select substr(value, 1, 1) + into decimalpoint + from nls_session_parameters + where parameter = 'NLS_NUMERIC_CHARACTERS'; + end update_decimalpoint; + + /* type json_src is record (len number, offset number, src varchar2(32767), s_clob clob); */ + /* assertions + offset: contains 0-base offset of buffer, + so 1-st entry is offset + 1, 4000-th entry = offset + 4000 + src: contains offset + 1 .. offset + 4000, ex. 1..4000, 4001..8000, etc. + */ + function next_char(indx number, s in out nocopy json_src) return varchar2 as + begin + if (indx > s.len) then return null; end if; + + --right offset? + /* if (indx > 4000 + s.offset or indx < s.offset) then */ + /* fix for issue #37 */ + /* code before fix for issue #169 + if (indx > 4000 + s.offset or indx <= s.offset) then + s.offset := indx - (indx mod 4000); + -- addon fix for issue #37 + if s.offset = indx then + s.offset := s.offset - 4000; + end if; + s.src := dbms_lob.substr(s.s_clob, 4000, s.offset+1); + end if; + --read from s.src + return substr(s.src, indx-s.offset, 1); + */ + + /* use of length, so works correctly for 4-byte unicode characters (issue #169) */ + /* lengthc does not work (issue #190) */ + if (indx > s.src_len + s.offset_chars) then + while (indx > length(s.src) + s.offset_chars) loop + s.offset_chars := s.offset_chars + length(s.src); + s.offset := s.offset + length2(s.src); + /* exception check, so works correctly for 4-byte unicode characters (issue #169) */ + begin + s.src := dbms_lob.substr(s.s_clob, buffer_amount, s.offset+1); + exception + when ucs2_exception then + s.src := dbms_lob.substr(s.s_clob, buffer_amount-1, s.offset+1); + end; + set_src_array(s); + end loop; + elsif (indx <= s.offset_chars) then + s.offset_chars := 0; + s.offset := 0; + /* exception check, so works correctly for 4-byte unicode characters (issue #169) */ + begin + s.src := dbms_lob.substr(s.s_clob, buffer_amount, s.offset+1); + exception + when ucs2_exception then + s.src := dbms_lob.substr(s.s_clob, buffer_amount-1, s.offset+1); + end; + set_src_array(s); + while (indx > length(s.src) + s.offset_chars) loop + s.offset_chars := s.offset_chars + length(s.src); + s.offset := s.offset + length2(s.src); + /* exception check, so works correctly for 4-byte unicode characters (issue #169) */ + begin + s.src := dbms_lob.substr(s.s_clob, buffer_amount, s.offset+1); + exception + when ucs2_exception then + s.src := dbms_lob.substr(s.s_clob, buffer_amount-1, s.offset+1); + end; + set_src_array(s); + end loop; + end if; + --dbms_output.put_line('indx: ' || indx || ' offset: ' || s.offset || ' (chars: ' || s.offset_chars || ') src chars: ' || length(s.src)); + return s.src_array(indx-s.offset_chars); + end; + + function next_char2(indx number, s in out nocopy json_src, amount number default 1) return varchar2 as + buf varchar2(32767) := ''; + begin + for i in 1..amount loop + buf := buf || next_char(indx-1+i, s); + end loop; + return buf; + end; + + function prepareClob(buf clob) return pljson_parser.json_src as + temp pljson_parser.json_src; + begin + temp.s_clob := buf; + temp.offset_chars := 0; + temp.offset := 0; + /* exception check, so works correctly for 4-byte unicode characters (issue #169) */ + begin + temp.src := dbms_lob.substr(buf, buffer_amount, temp.offset+1); + exception + when ucs2_exception then + temp.src := dbms_lob.substr(buf, buffer_amount-1, temp.offset+1); + end; + /* use of lengthcc, so works correctly for 4-byte unicode characters (issue #169) */ + temp.len := lengthcc(buf); --dbms_lob.getlength(buf); + set_src_array(temp); + return temp; + end; + + function prepareVarchar2(buf varchar2) return pljson_parser.json_src as + temp pljson_parser.json_src; + begin + temp.s_clob := buf; + temp.offset_chars := 0; + temp.offset := 0; + temp.src := substr(buf, 1, buffer_amount); + temp.len := length(buf); + set_src_array(temp); + return temp; + end; + + procedure debug(text varchar2) as + begin + dbms_output.put_line(text); + end; + + procedure print_token(t rToken) as + begin + dbms_output.put_line('Line: '||t.line||' - Column: '||t.col||' - Type: '||t.type_name||' - Content: '||t.data); + end print_token; + + /* SCANNER FUNCTIONS START */ + procedure s_error(text varchar2, line number, col number) as + begin + raise_application_error(-20100, 'JSON Scanner exception @ line: '||line||' column: '||col||' - '||text); + end; + + procedure s_error(text varchar2, tok rToken) as + begin + raise_application_error(-20100, 'JSON Scanner exception @ line: '||tok.line||' column: '||tok.col||' - '||text); + end; + + function mt(t varchar2, l pls_integer, c pls_integer, d varchar2) return rToken as + token rToken; + begin + token.type_name := t; + token.line := l; + token.col := c; + token.data := d; + return token; + end; + + function lexNumber(jsrc in out nocopy json_src, tok in out nocopy rToken, indx in out nocopy pls_integer) return pls_integer as + numbuf varchar2(4000) := ''; + buf varchar2(4); + checkLoop boolean; + begin + buf := next_char(indx, jsrc); + if (buf = '-') then numbuf := '-'; indx := indx + 1; end if; + buf := next_char(indx, jsrc); + --0 or [1-9]([0-9])* + if (buf = '0') then + numbuf := numbuf || '0'; indx := indx + 1; + buf := next_char(indx, jsrc); + elsif (buf >= '1' and buf <= '9') then + numbuf := numbuf || buf; indx := indx + 1; + --read digits + buf := next_char(indx, jsrc); + while (buf >= '0' and buf <= '9') loop + numbuf := numbuf || buf; indx := indx + 1; + buf := next_char(indx, jsrc); + end loop; + end if; + --fraction + if (buf = '.') then + numbuf := numbuf || buf; indx := indx + 1; + buf := next_char(indx, jsrc); + checkLoop := FALSE; + while (buf >= '0' and buf <= '9') loop + checkLoop := TRUE; + numbuf := numbuf || buf; indx := indx + 1; + buf := next_char(indx, jsrc); + end loop; + if (not checkLoop) then + s_error('Expected: digits in fraction', tok); + end if; + end if; + --exp part + if (buf in ('e', 'E')) then + numbuf := numbuf || buf; indx := indx + 1; + buf := next_char(indx, jsrc); + if (buf = '+' or buf = '-') then + numbuf := numbuf || buf; indx := indx + 1; + buf := next_char(indx, jsrc); + end if; + checkLoop := FALSE; + while (buf >= '0' and buf <= '9') loop + checkLoop := TRUE; + numbuf := numbuf || buf; indx := indx + 1; + buf := next_char(indx, jsrc); + end loop; + if (not checkLoop) then + s_error('Expected: digits in exp', tok); + end if; + end if; + + tok.data := numbuf; + return indx; + end lexNumber; + + -- [a-zA-Z]([a-zA-Z0-9])* + function lexName(jsrc in out nocopy json_src, tok in out nocopy rToken, indx in out nocopy pls_integer) return pls_integer as + varbuf varchar2(32767) := ''; + buf varchar(4); + num number; + begin + buf := next_char(indx, jsrc); + while (REGEXP_LIKE(buf, '^[[:alnum:]\_]$', 'i')) loop + varbuf := varbuf || buf; + indx := indx + 1; + buf := next_char(indx, jsrc); + if (buf is null) then + goto retname; + --debug('Premature string ending'); + end if; + end loop; + <> + --could check for reserved keywords here + --debug(varbuf); + tok.data := varbuf; + return indx-1; + end lexName; + + procedure updateClob(v_extended in out nocopy clob, v_str varchar2) as + begin + /* use of length2, so works correctly for 4-byte unicode characters (issue #169) */ + dbms_lob.writeappend(v_extended, length2(v_str), v_str); + end updateClob; + + function lexString(jsrc in out nocopy json_src, tok in out nocopy rToken, indx in out nocopy pls_integer, endChar char) return pls_integer as + v_extended clob := null; v_count number := 0; + varbuf varchar2(32767) := ''; + buf varchar(4); + wrong boolean; + max_string_chars number := 5000; /* chunk size, less than this number may be copied */ + begin + indx := indx + 1; + buf := next_char(indx, jsrc); + while (buf != endChar) loop + --clob control + if (v_count > 8191) then --crazy oracle error (16383 is the highest working length with unistr - 8192 choosen to be safe) + if (v_extended is null) then + v_extended := empty_clob(); + dbms_lob.createtemporary(v_extended, true); + end if; + updateClob(v_extended, unistr(varbuf)); + varbuf := ''; v_count := 0; + end if; + if (buf = Chr(13) or buf = CHR(9) or buf = CHR(10)) then + s_error('Control characters not allowed (CHR(9),CHR(10),CHR(13))', tok); + end if; + if (buf = '\') then + --varbuf := varbuf || buf; + indx := indx + 1; + buf := next_char(indx, jsrc); + case + when buf in ('\') then + varbuf := varbuf || buf || buf; v_count := v_count + 2; + indx := indx + 1; + buf := next_char(indx, jsrc); + when buf in ('"', '/') then + varbuf := varbuf || buf; v_count := v_count + 1; + indx := indx + 1; + buf := next_char(indx, jsrc); + when buf = '''' then + if (json_strict = false) then + varbuf := varbuf || buf; v_count := v_count + 1; + indx := indx + 1; + buf := next_char(indx, jsrc); + else + s_error('strictmode - expected: " \ / b f n r t u ', tok); + end if; + when buf in ('b', 'f', 'n', 'r', 't') then + --backspace b = U+0008 + --formfeed f = U+000C + --newline n = U+000A + --carret r = U+000D + --tabulator t = U+0009 + case buf + when 'b' then varbuf := varbuf || chr(8); + when 'f' then varbuf := varbuf || chr(12); + when 'n' then varbuf := varbuf || chr(10); + when 'r' then varbuf := varbuf || chr(13); + when 't' then varbuf := varbuf || chr(9); + end case; + --varbuf := varbuf || buf; + v_count := v_count + 1; + indx := indx + 1; + buf := next_char(indx, jsrc); + when buf = 'u' then + --four hexadecimal chars + declare + four varchar2(4); + begin + four := next_char2(indx+1, jsrc, 4); + wrong := FALSE; + if (upper(substr(four, 1, 1)) not in ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','a','b','c','d','e','f')) then wrong := TRUE; end if; + if (upper(substr(four, 2, 1)) not in ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','a','b','c','d','e','f')) then wrong := TRUE; end if; + if (upper(substr(four, 3, 1)) not in ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','a','b','c','d','e','f')) then wrong := TRUE; end if; + if (upper(substr(four, 4, 1)) not in ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','a','b','c','d','e','f')) then wrong := TRUE; end if; + if (wrong) then + s_error('expected: " \u([0-9][A-F]){4}', tok); + end if; +-- varbuf := varbuf || buf || four; + varbuf := varbuf || '\'||four;--chr(to_number(four,'XXXX')); + v_count := v_count + 5; + indx := indx + 5; + buf := next_char(indx, jsrc); + end; + else + s_error('expected: " \ / b f n r t u ', tok); + end case; + else + varbuf := varbuf || buf; v_count := v_count + 1; + indx := indx + 1; + buf := next_char(indx, jsrc); + end if; + end loop; + + if (buf is null) then + s_error('string ending not found', tok); + --debug('Premature string ending'); + end if; + + --debug(varbuf); + --dbms_output.put_line(varbuf); + if (v_extended is not null) then + updateClob(v_extended, unistr(varbuf)); + tok.data_overflow := v_extended; + -- tok.data := dbms_lob.substr(v_extended, 1, 32767); + /* may read less than "max_string_chars" characters but it's a sample so doesn't matter */ + dbms_lob.read(v_extended, max_string_chars, 1, tok.data); + else + tok.data := unistr(varbuf); + end if; + return indx; + end lexString; + + /* scanner tokens: + '{', '}', ',', ':', '[', ']', STRING, NUMBER, TRUE, FALSE, NULL + */ + function lexer(jsrc in out nocopy json_src) return lTokens as + tokens lTokens; + indx pls_integer := 1; + tok_indx pls_integer := 1; + buf varchar2(4); + lin_no number := 1; + col_no number := 0; + begin + while (indx <= jsrc.len) loop + --read into buf + buf := next_char(indx, jsrc); + col_no := col_no + 1; + --convert to switch case + case + when buf = '{' then tokens(tok_indx) := mt('{', lin_no, col_no, null); tok_indx := tok_indx + 1; + when buf = '}' then tokens(tok_indx) := mt('}', lin_no, col_no, null); tok_indx := tok_indx + 1; + when buf = ',' then tokens(tok_indx) := mt(',', lin_no, col_no, null); tok_indx := tok_indx + 1; + when buf = ':' then tokens(tok_indx) := mt(':', lin_no, col_no, null); tok_indx := tok_indx + 1; + when buf = '[' then tokens(tok_indx) := mt('[', lin_no, col_no, null); tok_indx := tok_indx + 1; + when buf = ']' then tokens(tok_indx) := mt(']', lin_no, col_no, null); tok_indx := tok_indx + 1; + when buf = 't' then + if (next_char2(indx, jsrc, 4) != 'true') then + if (json_strict = false and REGEXP_LIKE(buf, '^[[:alpha:]]$', 'i')) then + tokens(tok_indx) := mt('STRING', lin_no, col_no, null); + indx := lexName(jsrc, tokens(tok_indx), indx); + col_no := col_no + length(tokens(tok_indx).data) + 1; + tok_indx := tok_indx + 1; + else + s_error('Expected: ''true''', lin_no, col_no); + end if; + else + tokens(tok_indx) := mt('TRUE', lin_no, col_no, null); tok_indx := tok_indx + 1; + indx := indx + 3; + col_no := col_no + 3; + end if; + when buf = 'n' then + if (next_char2(indx, jsrc, 4) != 'null') then + if (json_strict = false and REGEXP_LIKE(buf, '^[[:alpha:]]$', 'i')) then + tokens(tok_indx) := mt('STRING', lin_no, col_no, null); + indx := lexName(jsrc, tokens(tok_indx), indx); + col_no := col_no + length(tokens(tok_indx).data) + 1; + tok_indx := tok_indx + 1; + else + s_error('Expected: ''null''', lin_no, col_no); + end if; + else + tokens(tok_indx) := mt('NULL', lin_no, col_no, null); tok_indx := tok_indx + 1; + indx := indx + 3; + col_no := col_no + 3; + end if; + when buf = 'f' then + if (next_char2(indx, jsrc, 5) != 'false') then + if (json_strict = false and REGEXP_LIKE(buf, '^[[:alpha:]]$', 'i')) then + tokens(tok_indx) := mt('STRING', lin_no, col_no, null); + indx := lexName(jsrc, tokens(tok_indx), indx); + col_no := col_no + length(tokens(tok_indx).data) + 1; + tok_indx := tok_indx + 1; + else + s_error('Expected: ''false''', lin_no, col_no); + end if; + else + tokens(tok_indx) := mt('FALSE', lin_no, col_no, null); tok_indx := tok_indx + 1; + indx := indx + 4; + col_no := col_no + 4; + end if; + /* -- 9 = TAB, 10 = \n, 13 = \r (Linux = \n, Windows = \r\n, Mac = \r */ + when (buf = Chr(10)) then --linux newlines + lin_no := lin_no + 1; + col_no := 0; + + when (buf = Chr(13)) then --Windows or Mac way + lin_no := lin_no + 1; + col_no := 0; + if (jsrc.len >= indx+1) then -- better safe than sorry + buf := next_char(indx+1, jsrc); + if (buf = Chr(10)) then --\r\n + indx := indx + 1; + end if; + end if; + + when (buf = CHR(9)) then null; --tabbing + when (buf in ('-', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9')) then --number + tokens(tok_indx) := mt('NUMBER', lin_no, col_no, null); + indx := lexNumber(jsrc, tokens(tok_indx), indx)-1; + col_no := col_no + length(tokens(tok_indx).data); + tok_indx := tok_indx + 1; + when buf = '"' then --string + tokens(tok_indx) := mt('STRING', lin_no, col_no, null); + indx := lexString(jsrc, tokens(tok_indx), indx, '"'); + col_no := col_no + length(tokens(tok_indx).data) + 1; + tok_indx := tok_indx + 1; + when buf = '''' and json_strict = false then --string + tokens(tok_indx) := mt('STRING', lin_no, col_no, null); + indx := lexString(jsrc, tokens(tok_indx), indx, ''''); + col_no := col_no + length(tokens(tok_indx).data) + 1; --hovsa her + tok_indx := tok_indx + 1; + when json_strict = false and REGEXP_LIKE(buf, '^[[:alpha:]]$', 'i') then + tokens(tok_indx) := mt('STRING', lin_no, col_no, null); + indx := lexName(jsrc, tokens(tok_indx), indx); + if (tokens(tok_indx).data_overflow is not null) then + /* use of lengthcc, so works correctly for 4-byte unicode characters (issue #169) */ + col_no := col_no + lengthcc(tokens(tok_indx).data_overflow) + 1; --dbms_lob.getlength(tokens(tok_indx).data_overflow) + 1; + else + col_no := col_no + length(tokens(tok_indx).data) + 1; + end if; + tok_indx := tok_indx + 1; + when json_strict = false and buf||next_char(indx+1, jsrc) = '/*' then --strip comments + declare + saveindx number := indx; + un_esc clob; + begin + indx := indx + 1; + loop + indx := indx + 1; + buf := next_char(indx, jsrc)||next_char(indx+1, jsrc); + exit when buf = '*/'; + exit when buf is null; + end loop; + + if (indx = saveindx+2) then + --enter unescaped mode + --dbms_output.put_line('Entering unescaped mode'); + un_esc := empty_clob(); + dbms_lob.createtemporary(un_esc, true); + indx := indx + 1; + loop + indx := indx + 1; + buf := next_char(indx, jsrc)||next_char(indx+1, jsrc)||next_char(indx+2, jsrc)||next_char(indx+3, jsrc); + exit when buf = '/**/'; + if buf is null then + s_error('Unexpected sequence /**/ to end unescaped data: '||buf, lin_no, col_no); + end if; + buf := next_char(indx, jsrc); + /* use of length2, so works correctly for 4-byte unicode characters (issue #169) */ + dbms_lob.writeappend(un_esc, length2(buf), buf); + end loop; + tokens(tok_indx) := mt('ESTRING', lin_no, col_no, null); + tokens(tok_indx).data_overflow := un_esc; + /* use of lengthcc, so works correctly for 4-byte unicode characters (issue #169) */ + col_no := col_no + lengthcc(un_esc) + 1; --dbms_lob.getlength(un_esc) + 1; --note: line count won't work properly + tok_indx := tok_indx + 1; + indx := indx + 2; + end if; + + indx := indx + 1; + end; + when buf = ' ' then null; --space + else + s_error('Unexpected char: '||buf, lin_no, col_no); + end case; + + indx := indx + 1; + end loop; + + return tokens; + end lexer; + + /* SCANNER END */ + + /* PARSER FUNCTIONS START */ + procedure p_error(text varchar2, tok rToken) as + begin + raise_application_error(-20101, 'JSON Parser exception @ line: '||tok.line||' column: '||tok.col||' - '||text); + end; + + function parseArr(tokens lTokens, indx in out nocopy pls_integer) return pljson_list as + e_arr pljson_element_array := pljson_element_array(); + ret_list pljson_list := pljson_list(); + v_count number := 0; + tok rToken; + pv pljson_number; + begin + --value, value, value ] + if (indx > tokens.count) then p_error('more elements in array was excepted', tok); end if; + tok := tokens(indx); + while (tok.type_name != ']') loop + e_arr.extend; + v_count := v_count + 1; + case tok.type_name + when 'TRUE' then e_arr(v_count) := pljson_bool(true); + when 'FALSE' then e_arr(v_count) := pljson_bool(false); + when 'NULL' then e_arr(v_count) := pljson_null(); + when 'STRING' then e_arr(v_count) := case when tok.data_overflow is not null then pljson_string(tok.data_overflow) else pljson_string(tok.data) end; + when 'ESTRING' then e_arr(v_count) := pljson_string(tok.data_overflow, false); + /* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */ + --when 'NUMBER' then e_arr(v_count) := pljson_number(to_number(replace(tok.data, '.', decimalpoint))); + when 'NUMBER' then + pv := pljson_number(0); + pv.parse_number(replace(tok.data, '.', decimalpoint)); + e_arr(v_count) := pv; + when '[' then + declare e_list pljson_list; begin + indx := indx + 1; + e_list := parseArr(tokens, indx); + e_arr(v_count) := e_list; + end; + when '{' then + indx := indx + 1; + e_arr(v_count) := parseObj(tokens, indx); + else + p_error('Expected a value', tok); + end case; + indx := indx + 1; + if (indx > tokens.count) then p_error('] not found', tok); end if; + tok := tokens(indx); + if (tok.type_name = ',') then --advance + indx := indx + 1; + if (indx > tokens.count) then p_error('more elements in array was excepted', tok); end if; + tok := tokens(indx); + if (tok.type_name = ']') then --premature exit + p_error('Premature exit in array', tok); + end if; + elsif (tok.type_name != ']') then --error + p_error('Expected , or ]', tok); + end if; + + end loop; + ret_list.list_data := e_arr; + return ret_list; + end parseArr; + + function parseMem(tokens lTokens, indx in out pls_integer, mem_name varchar2, mem_indx number) return pljson_element as + mem pljson_element; + tok rToken; + pv pljson_number; + begin + tok := tokens(indx); + case tok.type_name + when 'TRUE' then mem := pljson_bool(true); + when 'FALSE' then mem := pljson_bool(false); + when 'NULL' then mem := pljson_null(); + when 'STRING' then mem := case when tok.data_overflow is not null then pljson_string(tok.data_overflow) else pljson_string(tok.data) end; + when 'ESTRING' then mem := pljson_string(tok.data_overflow, false); + /* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */ + --when 'NUMBER' then mem := pljson_number(to_number(replace(tok.data, '.', decimalpoint))); + when 'NUMBER' then + pv := pljson_number(0); + pv.parse_number(replace(tok.data, '.', decimalpoint)); + mem := pv; + when '[' then + declare + e_list pljson_list; + begin + indx := indx + 1; + e_list := parseArr(tokens, indx); + mem := e_list; + end; + when '{' then + indx := indx + 1; + mem := parseObj(tokens, indx); + else + p_error('Found '||tok.type_name, tok); + end case; + mem.mapname := mem_name; + mem.mapindx := mem_indx; + + indx := indx + 1; + return mem; + end parseMem; + + /*procedure test_duplicate_members(arr in json_member_array, mem_name in varchar2, wheretok rToken) as + begin + for i in 1 .. arr.count loop + if (arr(i).member_name = mem_name) then + p_error('Duplicate member name', wheretok); + end if; + end loop; + end test_duplicate_members;*/ + + function parseObj(tokens lTokens, indx in out nocopy pls_integer) return pljson as + type memmap is table of number index by varchar2(4000); -- i've read somewhere that this is not possible - but it is! + mymap memmap; + nullelemfound boolean := false; + + obj pljson; + tok rToken; + mem_name varchar(4000); + arr pljson_element_array := pljson_element_array(); + begin + --what to expect? + while (indx <= tokens.count) loop + tok := tokens(indx); + --debug('E: '||tok.type_name); + case tok.type_name + when 'STRING' then + --member + mem_name := substr(tok.data, 1, 4000); + begin + if (mem_name is null) then + if (nullelemfound) then + p_error('Duplicate empty member: ', tok); + else + nullelemfound := true; + end if; + elsif (mymap(mem_name) is not null) then + p_error('Duplicate member name: '||mem_name, tok); + end if; + exception + when no_data_found then mymap(mem_name) := 1; + end; + + indx := indx + 1; + if (indx > tokens.count) then p_error('Unexpected end of input', tok); end if; + tok := tokens(indx); + indx := indx + 1; + if (indx > tokens.count) then p_error('Unexpected end of input', tok); end if; + if (tok.type_name = ':') then + --parse + declare + jmb pljson_element; + x number; + begin + x := arr.count + 1; + jmb := parseMem(tokens, indx, mem_name, x); + arr.extend; + arr(x) := jmb; + end; + else + p_error('Expected '':''', tok); + end if; + --move indx forward if ',' is found + if (indx > tokens.count) then p_error('Unexpected end of input', tok); end if; + + tok := tokens(indx); + if (tok.type_name = ',') then + --debug('found ,'); + indx := indx + 1; + tok := tokens(indx); + if (tok.type_name = '}') then --premature exit + p_error('Premature exit in json object', tok); + end if; + elsif (tok.type_name != '}') then + p_error('A comma seperator is probably missing', tok); + end if; + when '}' then + obj := pljson(); + obj.json_data := arr; + return obj; + else + p_error('Expected string or }', tok); + end case; + end loop; + + p_error('} not found', tokens(indx-1)); + + return obj; + + end; + + function parser(str varchar2) return pljson as + tokens lTokens; + obj pljson; + indx pls_integer := 1; + jsrc json_src; + begin + --update_decimalpoint(); + jsrc := prepareVarchar2(str); + tokens := lexer(jsrc); + if (tokens(indx).type_name = '{') then + indx := indx + 1; + obj := parseObj(tokens, indx); + else + raise_application_error(-20101, 'JSON Parser exception - no { start found'); + end if; + if (tokens.count != indx) then + p_error('} should end the JSON object', tokens(indx)); + end if; + + return obj; + end parser; + + function parse_list(str varchar2) return pljson_list as + tokens lTokens; + obj pljson_list; + indx pls_integer := 1; + jsrc json_src; + begin + --update_decimalpoint(); + jsrc := prepareVarchar2(str); + tokens := lexer(jsrc); + if (tokens(indx).type_name = '[') then + indx := indx + 1; + obj := parseArr(tokens, indx); + else + raise_application_error(-20101, 'JSON List Parser exception - no [ start found'); + end if; + if (tokens.count != indx) then + p_error('] should end the JSON List object', tokens(indx)); + end if; + + return obj; + end parse_list; + + function parse_list(str clob) return pljson_list as + tokens lTokens; + obj pljson_list; + indx pls_integer := 1; + jsrc json_src; + begin + --update_decimalpoint(); + jsrc := prepareClob(str); + tokens := lexer(jsrc); + if (tokens(indx).type_name = '[') then + indx := indx + 1; + obj := parseArr(tokens, indx); + else + raise_application_error(-20101, 'JSON List Parser exception - no [ start found'); + end if; + if (tokens.count != indx) then + p_error('] should end the JSON List object', tokens(indx)); + end if; + + return obj; + end parse_list; + + function parser(str clob) return pljson as + tokens lTokens; + obj pljson; + indx pls_integer := 1; + jsrc json_src; + begin + --update_decimalpoint(); + --dbms_output.put_line('Using clob'); + jsrc := prepareClob(str); + tokens := lexer(jsrc); + if (tokens(indx).type_name = '{') then + indx := indx + 1; + obj := parseObj(tokens, indx); + else + raise_application_error(-20101, 'JSON Parser exception - no { start found'); + end if; + if (tokens.count != indx) then + p_error('} should end the JSON object', tokens(indx)); + end if; + + return obj; + end parser; + + function parse_any(str varchar2) return pljson_element as + tokens lTokens; + obj pljson_list; + ret pljson_element; + indx pls_integer := 1; + jsrc json_src; + begin + --update_decimalpoint(); + jsrc := prepareVarchar2(str); + tokens := lexer(jsrc); + tokens(tokens.count+1).type_name := ']'; + obj := parseArr(tokens, indx); + if (tokens.count != indx) then + p_error('] should end the JSON List object', tokens(indx)); + end if; + + return obj.head(); + end parse_any; + + function parse_any(str clob) return pljson_element as + tokens lTokens; + obj pljson_list; + indx pls_integer := 1; + jsrc json_src; + begin + --update_decimalpoint(); + jsrc := prepareClob(str); + tokens := lexer(jsrc); + tokens(tokens.count+1).type_name := ']'; + obj := parseArr(tokens, indx); + if (tokens.count != indx) then + p_error('] should end the JSON List object', tokens(indx)); + end if; + + return obj.head(); + end parse_any; + + /* last entry is the one to keep */ + procedure remove_duplicates(obj in out nocopy pljson) as + type memberlist is table of pljson_element index by varchar2(4000); + members memberlist; + nulljsonvalue pljson_element := null; + validated pljson := pljson(); + indx varchar2(4000); + begin + for i in 1 .. obj.count loop + if (obj.get(i).mapname is null) then + nulljsonvalue := obj.get(i); + else + members(obj.get(i).mapname) := obj.get(i); + end if; + end loop; + + validated.check_duplicate(false); + indx := members.first; + loop + exit when indx is null; + validated.put(indx, members(indx)); + indx := members.next(indx); + end loop; + if (nulljsonvalue is not null) then + validated.put('', nulljsonvalue); + end if; + + validated.check_for_duplicate := obj.check_for_duplicate; + + obj := validated; + end; + + function get_version return varchar2 as + begin + return 'PL/JSON {{PLJSON_VERSION}}'; + end get_version; + +begin + update_decimalpoint(); +end pljson_parser; +/ +show err + + +-- --- pljson_printer.package (spec + body) --- +create or replace package pljson_printer as + /* + Copyright (c) 2010 Jonas Krogsboell + Permission is hereby granted, free of charge, to any person obtaining a copy + of this software and associated documentation files (the "Software"), to deal + in the Software without restriction, including without limitation the rights + to use, copy, modify, merge, publish, distribute, sublicense, and/or sell + copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN + THE SOFTWARE. + */ + indent_string varchar2(10 char) := ' '; --chr(9); for tab + newline_char varchar2(2 char) := chr(13)||chr(10); -- Windows style + --newline_char varchar2(2) := chr(10); -- Mac style + --newline_char varchar2(2) := chr(13); -- Linux style + ascii_output boolean not null := true; + empty_string_as_null boolean not null := false; + escape_solidus boolean not null := false; + unescaped_string_delim varchar2(10 char) := '/**/'; + + function pretty_print(obj pljson, spaces boolean default true, line_length number default 0) return varchar2; + function pretty_print_list(obj pljson_list, spaces boolean default true, line_length number default 0) return varchar2; + function pretty_print_any(json_part pljson_element, spaces boolean default true, line_length number default 0) return varchar2; + procedure pretty_print(obj pljson, spaces boolean default true, buf in out nocopy clob, line_length number default 0, erase_clob boolean default true); + procedure pretty_print_list(obj pljson_list, spaces boolean default true, buf in out nocopy clob, line_length number default 0, erase_clob boolean default true); + procedure pretty_print_any(json_part pljson_element, spaces boolean default true, buf in out nocopy clob, line_length number default 0, erase_clob boolean default true); + + procedure dbms_output_clob(my_clob clob, delim varchar2, jsonp varchar2 default null); + procedure htp_output_clob(my_clob clob, jsonp varchar2 default null); + -- made public just for testing/profiling... + function escapeString(str varchar2) return varchar2; + +end pljson_printer; +/ +show err + +create or replace package body pljson_printer as + max_line_len number := 0; + cur_line_len number := 0; + + -- associative array used inside escapeString to cache the escaped version of every character + -- escaped so far (example: char_map('"') contains the '\"' string) + -- (if the character does not need to be escaped, the character is stored unchanged in the array itself) + -- type Rmap_char is record(buf varchar2(40), len integer); + type Tmap_char_string is table of varchar2(40) index by varchar2(1 char); /* index by unicode char */ + char_map Tmap_char_string; + -- since char_map the associative array is a global variable reused across multiple calls to escapeString, + -- i need to be able to detect that the escape_solidus or ascii_output global parameters have been changed, + -- in order to clear it and avoid using escape sequences that have been cached using the previous values + char_map_escape_solidus boolean := escape_solidus; + char_map_ascii_output boolean := ascii_output; + + function llcheck(str in varchar2) return varchar2 as + begin + --dbms_output.put_line(cur_line_len || ' : ' || str); + if (max_line_len > 0 and length(str)+cur_line_len > max_line_len) then + cur_line_len := length(str); + return newline_char || str; + else + cur_line_len := cur_line_len + length(str); + return str; + end if; + end llcheck; + + -- escapes a single character. + function escapeChar(ch char) return varchar2 deterministic is + result varchar2(20); + begin + --backspace b = U+0008 + --formfeed f = U+000C + --newline n = U+000A + --carret r = U+000D + --tabulator t = U+0009 + result := ch; + + case ch + when chr( 8) then result := '\b'; + when chr( 9) then result := '\t'; + when chr(10) then result := '\n'; + when chr(12) then result := '\f'; + when chr(13) then result := '\r'; + when chr(34) then result := '\"'; + when chr(47) then if (escape_solidus) then result := '\/'; end if; + when chr(92) then result := '\\'; + /* WARNING: ascii() returns PLS_INTEGER and large unicode code points can be negative */ + else if (ascii(ch) >= 0 and ascii(ch) < 32) then + result := '\u' || replace(substr(to_char(ascii(ch), 'XXXX'), 2, 4), ' ', '0'); + elsif (ascii_output) then + result := replace(asciistr(ch), '\', '\u'); + end if; + end case; + return result; + end; + + function escapeString(str varchar2) return varchar2 as + sb varchar2(32767 byte) := ''; + buf varchar2(40); + ch varchar2(1 char); /* unicode char */ + begin + if (str is null) then return ''; end if; + + -- clear the cache if global parameters have been changed + if char_map_escape_solidus <> escape_solidus or + char_map_ascii_output <> ascii_output + then + char_map.delete; + char_map_escape_solidus := escape_solidus; + char_map_ascii_output := ascii_output; + end if; + + for i in 1 .. length(str) loop + ch := substr(str, i, 1 ) ; + + begin + -- it this char has already been processed, I have cached its escaped value + buf:=char_map(ch); + exception when no_Data_found then + -- otherwise, i convert the value and add it to the cache + buf := escapeChar(ch); + char_map(ch) := buf; + end; + + sb := sb || buf; + end loop; + return sb; + end escapeString; + + function newline(spaces boolean) return varchar2 as + begin + cur_line_len := 0; + if (spaces) then return newline_char; else return ''; end if; + end; + +/* function get_schema return varchar2 as + begin + return sys_context('userenv', 'current_schema'); + end; +*/ + function tab(indent number, spaces boolean) return varchar2 as + i varchar(200) := ''; + begin + if (not spaces) then return ''; end if; + for x in 1 .. indent loop i := i || indent_string; end loop; + return i; + end; + + function string_delim(elem pljson_string) return varchar2 as + begin + return + case when elem.num = 1 then '"' + else + case when elem.unescaped_string_delim_p = 1 then elem.unescaped_string_delim + else pljson_printer.unescaped_string_delim + end + end; + end; + + function getCommaSep(spaces boolean) return varchar2 as + begin + if (spaces) then return ', '; else return ','; end if; + end; + + function getMemName(mem pljson_element, spaces boolean) return varchar2 as + begin + if (spaces) then + return llcheck('"'||escapeString(mem.mapname)||'"') || llcheck(' : '); + else + return llcheck('"'||escapeString(mem.mapname)||'"') || llcheck(':'); + end if; + end; + + + /* clob methods begin */ + + procedure add_to_clob(buf_lob in out nocopy clob, buf_str in out nocopy varchar2, str varchar2) as + begin + -- if (length(str) > 5000 - length(buf_str)) then + if (lengthb(str) > 32767 - lengthb(buf_str)) then + -- dbms_lob.writeappend(buf_lob, length2(buf_str), buf_str); + dbms_lob.append(buf_lob, buf_str); + buf_str := str; + else + buf_str := buf_str || str; + end if; + end add_to_clob; + + procedure flush_clob(buf_lob in out nocopy clob, buf_str in out nocopy varchar2) as + begin + -- dbms_lob.writeappend(buf_lob, length2(buf_str), buf_str); + dbms_lob.append(buf_lob, buf_str); + end flush_clob; + + procedure ppObj(obj pljson, indent number, buf in out nocopy clob, spaces boolean, buf_str in out nocopy varchar2); + + procedure ppString(elem pljson_string, buf in out nocopy clob, buf_str in out nocopy varchar2) is + offset number := 1; + /* E.I.Sarmas (github.com/dsnz) 2016-01-21 limit to 5000 chars */ + v_str varchar(5000 char); + amount number := 5000; /* chunk size for use in escapeString, less than this number may be copied */ + begin + if empty_string_as_null and elem.extended_str is null and elem.str is null then + add_to_clob(buf, buf_str, 'null'); + else + add_to_clob(buf, buf_str, string_delim(elem)); + if (elem.extended_str is not null) then --clob implementation + while (offset <= dbms_lob.getlength(elem.extended_str)) loop + dbms_lob.read(elem.extended_str, amount, offset, v_str); + if (elem.num = 1) then + add_to_clob(buf, buf_str, escapeString(v_str)); + else + add_to_clob(buf, buf_str, v_str); + end if; + offset := offset + amount; + end loop; + else + if (elem.num = 1) then + while (offset <= length(elem.str)) loop + v_str:=substr(elem.str, offset, amount); + add_to_clob(buf, buf_str, escapeString(v_str)); + offset := offset + amount; + end loop; + else + add_to_clob(buf, buf_str, elem.str); + end if; + end if; + add_to_clob(buf, buf_str, string_delim(elem)); + end if; + end; + + procedure ppEA(input pljson_list, indent number, buf in out nocopy clob, spaces boolean, buf_str in out nocopy varchar2) as + elem pljson_element; + arr pljson_element_array := input.list_data; + numbuf varchar2(4000); + begin + for y in 1 .. arr.count loop + elem := arr(y); + if (elem is not null) then + case elem.typeval + /* number */ + when 4 then + numbuf := treat(elem as pljson_number).number_toString(); + add_to_clob(buf, buf_str, llcheck(numbuf)); + /* string */ + when 3 then + ppString(treat(elem as pljson_string), buf, buf_str); + /* bool */ + when 5 then + if (elem.get_bool()) then + add_to_clob(buf, buf_str, llcheck('true')); + else + add_to_clob(buf, buf_str, llcheck('false')); + end if; + /* null */ + when 6 then + add_to_clob(buf, buf_str, llcheck('null')); + /* array */ + when 2 then + add_to_clob(buf, buf_str, llcheck('[')); + ppEA(treat(elem as pljson_list), indent, buf, spaces, buf_str); + add_to_clob(buf, buf_str, llcheck(']')); + /* object */ + when 1 then + ppObj(treat(elem as pljson), indent, buf, spaces, buf_str); + else + add_to_clob(buf, buf_str, llcheck(elem.get_type)); + end case; + end if; + if (y != arr.count) then add_to_clob(buf, buf_str, llcheck(getCommaSep(spaces))); end if; + end loop; + end ppEA; + + procedure ppMem(mem pljson_element, indent number, buf in out nocopy clob, spaces boolean, buf_str in out nocopy varchar2) as + numbuf varchar2(4000); + begin + add_to_clob(buf, buf_str, llcheck(tab(indent, spaces)) || llcheck(getMemName(mem, spaces))); + case mem.typeval + /* number */ + when 4 then + numbuf := treat(mem as pljson_number).number_toString(); + add_to_clob(buf, buf_str, llcheck(numbuf)); + /* string */ + when 3 then + ppString(treat(mem as pljson_string), buf, buf_str); + /* bool */ + when 5 then + if (mem.get_bool()) then + add_to_clob(buf, buf_str, llcheck('true')); + else + add_to_clob(buf, buf_str, llcheck('false')); + end if; + /* null */ + when 6 then + add_to_clob(buf, buf_str, llcheck('null')); + /* array */ + when 2 then + add_to_clob(buf, buf_str, llcheck('[')); + ppEA(treat(mem as pljson_list), indent, buf, spaces, buf_str); + add_to_clob(buf, buf_str, llcheck(']')); + /* object */ + when 1 then + ppObj(treat(mem as pljson), indent, buf, spaces, buf_str); + else + add_to_clob(buf, buf_str, llcheck(mem.get_type)); + end case; + end ppMem; + + procedure ppObj(obj pljson, indent number, buf in out nocopy clob, spaces boolean, buf_str in out nocopy varchar2) as + begin + add_to_clob(buf, buf_str, llcheck('{') || newline(spaces)); + for m in 1 .. obj.json_data.count loop + ppMem(obj.json_data(m), indent+1, buf, spaces, buf_str); + if (m != obj.json_data.count) then + add_to_clob(buf, buf_str, llcheck(',') || newline(spaces)); + else + add_to_clob(buf, buf_str, newline(spaces)); + end if; + end loop; + add_to_clob(buf, buf_str, llcheck(tab(indent, spaces)) || llcheck('}')); -- || chr(13); + end ppObj; + + procedure pretty_print(obj pljson, spaces boolean default true, buf in out nocopy clob, line_length number default 0, erase_clob boolean default true) as + buf_str varchar2(32767); + amount number := dbms_lob.getlength(buf); + begin + if (erase_clob and amount > 0) then + dbms_lob.trim(buf, 0); + -- dbms_lob.erase(buf, amount); + end if; + + max_line_len := line_length; + cur_line_len := 0; + ppObj(obj, 0, buf, spaces, buf_str); + flush_clob(buf, buf_str); + end; + + procedure pretty_print_list(obj pljson_list, spaces boolean default true, buf in out nocopy clob, line_length number default 0, erase_clob boolean default true) as + buf_str varchar2(32767); + amount number := dbms_lob.getlength(buf); + begin + if (erase_clob and amount > 0) then + dbms_lob.trim(buf, 0); + -- dbms_lob.erase(buf, amount); + end if; + + max_line_len := line_length; + cur_line_len := 0; + add_to_clob(buf, buf_str, llcheck('[')); + ppEA(obj, 0, buf, spaces, buf_str); + add_to_clob(buf, buf_str, llcheck(']')); + flush_clob(buf, buf_str); + end; + + procedure pretty_print_any(json_part pljson_element, spaces boolean default true, buf in out nocopy clob, line_length number default 0, erase_clob boolean default true) as + buf_str varchar2(32767) := ''; + numbuf varchar2(4000); + amount number := dbms_lob.getlength(buf); + begin + if (erase_clob and amount > 0) then + dbms_lob.trim(buf, 0); + -- dbms_lob.erase(buf, amount); + end if; + + case json_part.typeval + /* number */ + when 4 then + numbuf := treat(json_part as pljson_number).number_toString(); + add_to_clob(buf, buf_str, numbuf); + /* string */ + when 3 then + ppString(treat(json_part as pljson_string), buf, buf_str); + /* bool */ + when 5 then + if (json_part.get_bool()) then + add_to_clob(buf, buf_str, 'true'); + else + add_to_clob(buf, buf_str, 'false'); + end if; + /* null */ + when 6 then + add_to_clob(buf, buf_str, 'null'); + /* array */ + when 2 then + pretty_print_list(pljson_list(json_part), spaces, buf, line_length, erase_clob); + return; + /* object */ + when 1 then + pretty_print(pljson(json_part), spaces, buf, line_length, erase_clob); + return; + else + add_to_clob(buf, buf_str, 'unknown type:' || json_part.get_type); + end case; + flush_clob(buf, buf_str); + end; + + /* clob methods end */ + + + /* varchar2 methods begin */ + + procedure add_buf (buf in out nocopy varchar2, str in varchar2) as + begin + if (lengthb(str)>32767-lengthb(buf)) then + raise_application_error(-20001,'Length of result JSON more than 32767 bytes. Use to_clob() procedures'); + end if; + buf := buf || str; + end; + + procedure ppString(elem pljson_string, buf in out nocopy varchar2) is + offset number := 1; + /* E.I.Sarmas (github.com/dsnz) 2016-01-21 limit to 5000 chars */ + v_str varchar(5000 char); + amount number := 5000; /* chunk size for use in escapeString, less than this number may be copied */ + begin + if empty_string_as_null and elem.extended_str is null and elem.str is null then + add_buf(buf, 'null'); + else + add_buf(buf, string_delim(elem)); + if (elem.extended_str is not null) then --clob implementation + while (offset <= dbms_lob.getlength(elem.extended_str)) loop + dbms_lob.read(elem.extended_str, amount, offset, v_str); + if (elem.num = 1) then + add_buf(buf, escapeString(v_str)); + else + add_buf(buf, v_str); + end if; + offset := offset + amount; + end loop; + else + if (elem.num = 1) then + while (offset <= length(elem.str)) loop + v_str:=substr(elem.str, offset, amount); + add_buf(buf, escapeString(v_str)); + offset := offset + amount; + end loop; + else + add_buf(buf, elem.str); + end if; + end if; + add_buf(buf, string_delim(elem)); + end if; + end; + + procedure ppObj(obj pljson, indent number, buf in out nocopy varchar2, spaces boolean); + + procedure ppEA(input pljson_list, indent number, buf in out varchar2, spaces boolean) as + elem pljson_element; + arr pljson_element_array := input.list_data; + str varchar2(400); + begin + for y in 1 .. arr.count loop + elem := arr(y); + if (elem is not null) then + case elem.typeval + /* number */ + when 4 then + str := treat(elem as pljson_number).number_toString(); + add_buf(buf, llcheck(str)); + /* string */ + when 3 then + ppString(treat(elem as pljson_string), buf); + /* bool */ + when 5 then + if (elem.get_bool()) then + add_buf (buf, llcheck('true')); + else + add_buf (buf, llcheck('false')); + end if; + /* null */ + when 6 then + add_buf (buf, llcheck('null')); + /* array */ + when 2 then + add_buf( buf, llcheck('[')); + ppEA(treat(elem as pljson_list), indent, buf, spaces); + add_buf( buf, llcheck(']')); + /* object */ + when 1 then + ppObj(treat(elem as pljson), indent, buf, spaces); + else + add_buf (buf, llcheck(elem.get_type)); /* should never happen */ + end case; + end if; + if (y != arr.count) then add_buf(buf, llcheck(getCommaSep(spaces))); end if; + end loop; + end ppEA; + + procedure ppMem(mem pljson_element, indent number, buf in out nocopy varchar2, spaces boolean) as + str varchar2(400) := ''; + begin + add_buf(buf, llcheck(tab(indent, spaces)) || getMemName(mem, spaces)); + case mem.typeval + /* number */ + when 4 then + str := treat(mem as pljson_number).number_toString(); + add_buf(buf, llcheck(str)); + /* string */ + when 3 then + ppString(treat(mem as pljson_string), buf); + /* bool */ + when 5 then + if (mem.get_bool()) then + add_buf(buf, llcheck('true')); + else + add_buf(buf, llcheck('false')); + end if; + /* null */ + when 6 then + add_buf(buf, llcheck('null')); + /* array */ + when 2 then + add_buf(buf, llcheck('[')); + ppEA(treat(mem as pljson_list), indent, buf, spaces); + add_buf(buf, llcheck(']')); + /* object */ + when 1 then + ppObj(treat(mem as pljson), indent, buf, spaces); + else + add_buf(buf, llcheck(mem.get_type)); /* should never happen */ + end case; + end ppMem; + + procedure ppObj(obj pljson, indent number, buf in out nocopy varchar2, spaces boolean) as + begin + add_buf (buf, llcheck('{') || newline(spaces)); + for m in 1 .. obj.json_data.count loop + ppMem(obj.json_data(m), indent+1, buf, spaces); + if (m != obj.json_data.count) then + add_buf(buf, llcheck(',') || newline(spaces)); + else + add_buf(buf, newline(spaces)); + end if; + end loop; + add_buf(buf, llcheck(tab(indent, spaces)) || llcheck('}')); -- || chr(13); + end ppObj; + + function pretty_print(obj pljson, spaces boolean default true, line_length number default 0) return varchar2 as + buf varchar2(32767 byte) := ''; + begin + max_line_len := line_length; + cur_line_len := 0; + ppObj(obj, 0, buf, spaces); + return buf; + end pretty_print; + + function pretty_print_list(obj pljson_list, spaces boolean default true, line_length number default 0) return varchar2 as + buf varchar2(32767 byte) :=''; + begin + max_line_len := line_length; + cur_line_len := 0; + add_buf(buf, llcheck('[')); + ppEA(obj, 0, buf, spaces); + add_buf(buf, llcheck(']')); + return buf; + end; + + function pretty_print_any(json_part pljson_element, spaces boolean default true, line_length number default 0) return varchar2 as + buf varchar2(32767) := ''; + begin + case json_part.typeval + /* number */ + when 4 then + buf := treat(json_part as pljson_number).number_toString(); + /* string */ + when 3 then + ppString(treat(json_part as pljson_string), buf); + /* bool */ + when 5 then + if (json_part.get_bool()) then buf := 'true'; else buf := 'false'; end if; + /* null */ + when 6 then + buf := 'null'; + /* array */ + when 2 then + buf := pretty_print_list(pljson_list(json_part), spaces, line_length); + /* object */ + when 1 then + buf := pretty_print(pljson(json_part), spaces, line_length); + else + buf := 'weird error: ' || json_part.get_type; + end case; + return buf; + end; + + /* varchar2 methods end */ + + + procedure dbms_output_clob(my_clob clob, delim varchar2, jsonp varchar2 default null) as + prev number := 1; + indx number := 1; + size_of_nl number := length2(delim); + v_str varchar2(32767); + amount number; + max_string_chars number := 5000; /* chunk size, less than this number may be copied */ + begin + if (jsonp is not null) then dbms_output.put_line(jsonp||'('); end if; + while (indx != 0) loop + --read every line + indx := dbms_lob.instr(my_clob, delim, prev+1); + --dbms_output.put_line(prev || ' to ' || indx); + + if (indx = 0) then + --emit from prev to end; + amount := max_string_chars; + --dbms_output.put_line(' mycloblen ' || dbms_lob.getlength(my_clob)); + loop + dbms_lob.read(my_clob, amount, prev, v_str); + dbms_output.put_line(v_str); + prev := prev+amount; + exit when prev >= dbms_lob.getlength(my_clob); + end loop; + else + amount := indx - prev; + if (amount > max_string_chars) then + amount := max_string_chars; + --dbms_output.put_line(' mycloblen ' || dbms_lob.getlength(my_clob)); + loop + dbms_lob.read(my_clob, amount, prev, v_str); + dbms_output.put_line(v_str); + prev := prev+amount; + amount := indx - prev; + exit when prev >= indx - 1; + if (amount > max_string_chars) then + amount := max_string_chars; + end if; + end loop; + prev := indx + size_of_nl; + else + dbms_lob.read(my_clob, amount, prev, v_str); + dbms_output.put_line(v_str); + prev := indx + size_of_nl; + end if; + end if; + + end loop; + if (jsonp is not null) then dbms_output.put_line(')'); end if; + +/* while (amount != 0) loop + indx := dbms_lob.instr(my_clob, delim, prev+1); + +-- dbms_output.put_line(prev || ' to ' || indx); + if (indx = 0) then + indx := dbms_lob.getlength(my_clob)+1; + end if; + if (indx-prev > 32767) then + indx := prev+32767; + end if; +-- dbms_output.put_line(prev || ' to ' || indx); + --substr doesnt work properly on all platforms! (come on oracle - error on Oracle VM for virtualbox) +-- dbms_output.put_line(dbms_lob.substr(my_clob, indx-prev, prev)); + amount := indx-prev; +-- dbms_output.put_line('amount'||amount); + dbms_lob.read(my_clob, amount, prev, v_str); + dbms_output.put_line(v_str); + prev := indx+size_of_nl; + if (amount = 32767) then prev := prev-size_of_nl-1; end if; + end loop; + if (jsonp is not null) then dbms_output.put_line(')'); end if;*/ + end; + +/* +procedure dbms_output_clob(my_clob clob, delim varchar2, jsonp varchar2 default null) as + prev number := 1; + indx number := 1; + size_of_nl number := length2(delim); + v_str varchar2(32767); + amount number; + begin + if (jsonp is not null) then dbms_output.put_line(jsonp||'('); end if; + while (indx != 0) loop + indx := dbms_lob.instr(my_clob, delim, prev+1); + + --dbms_output.put_line(prev || ' to ' || indx); + if (indx-prev > 32767) then + indx := prev+32767; + end if; + --dbms_output.put_line(prev || ' to ' || indx); + --substr doesnt work properly on all platforms! (come on oracle - error on Oracle VM for virtualbox) + if (indx = 0) then + --dbms_output.put_line(dbms_lob.substr(my_clob, dbms_lob.getlength(my_clob)-prev+size_of_nl, prev)); + amount := dbms_lob.getlength(my_clob)-prev+size_of_nl; + dbms_lob.read(my_clob, amount, prev, v_str); + else + --dbms_output.put_line(dbms_lob.substr(my_clob, indx-prev, prev)); + amount := indx-prev; + --dbms_output.put_line('amount'||amount); + dbms_lob.read(my_clob, amount, prev, v_str); + end if; + dbms_output.put_line(v_str); + prev := indx+size_of_nl; + if (amount = 32767) then prev := prev-size_of_nl-1; end if; + end loop; + if (jsonp is not null) then dbms_output.put_line(')'); end if; + end; +*/ + + procedure htp_output_clob(my_clob clob, jsonp varchar2 default null) as + /*amount number := 4096; + pos number := 1; + len number; + */ + l_amt number default 4096; + l_off number default 1; + l_str varchar2(32000); + begin + if (jsonp is not null) then htp.prn(jsonp||'('); end if; + + begin + loop + dbms_lob.read( my_clob, l_amt, l_off, l_str ); + + -- it is vital to use htp.PRN to avoid + -- spurious line feeds getting added to your + -- document + htp.prn( l_str ); + l_off := l_off+l_amt; + end loop; + exception + when no_data_found then NULL; + end; + + /* + len := dbms_lob.getlength(my_clob); + + while (pos < len) loop + htp.prn(dbms_lob.substr(my_clob, amount, pos)); -- should I replace substr with dbms_lob.read? + --dbms_output.put_line(dbms_lob.substr(my_clob, amount, pos)); + pos := pos + amount; + end loop; + */ + if (jsonp is not null) then htp.prn(')'); end if; + end; + +end pljson_printer; +/ +show err + +-- --- pljson_ext.impl (body) --- +create or replace package body pljson_ext as + /* + Copyright (c) 2009 Jonas Krogsboell + + Permission is hereby granted, free of charge, to any person obtaining a copy + of this software and associated documentation files (the "Software"), to deal + in the Software without restriction, including without limitation the rights + to use, copy, modify, merge, publish, distribute, sublicense, and/or sell + copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN + THE SOFTWARE. + */ + + scanner_exception exception; + pragma exception_init(scanner_exception, -20100); + parser_exception exception; + pragma exception_init(parser_exception, -20101); + jext_exception exception; + pragma exception_init(jext_exception, -20110); + + --extra function checks if number has no fraction + function is_integer(v pljson_element) return boolean as + num number; + num_double binary_double; + int_number number(38); --the oracle way to specify an integer + int_double binary_double; --the oracle way to specify an integer + begin + /* + if (v.is_number()) then + myint := v.get_number(); + return (myint = v.get_number()); --no rounding errors? + else + return false; + end if; + */ + if (not v.is_number()) then + raise_application_error(-20109, 'not a number-value'); + end if; + /* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */ + if (v.is_number_repr_number()) then + num := v.get_number(); + int_number := trunc(num); + --dbms_output.put_line('number: ' || num || ' -> ' || int_number); + return (int_number = num); --no rounding errors? + elsif (v.is_number_repr_double()) then + num_double := v.get_double(); + int_double := trunc(num_double); + --dbms_output.put_line('double: ' || num_double || ' -> ' || int_double); + return (int_double = num_double); --no rounding errors? + else + return false; + end if; + end; + + --extension enables json to store dates without compromising the implementation + function to_json_string(d date) return pljson_string as + begin + return pljson_string(to_char(d, format_string)); + end; + + --notice that a date type in json is also a varchar2 + function is_date(v pljson_element) return boolean as + temp date; + begin + temp := pljson_ext.to_date(v); + return true; + exception + when others then + return false; + end; + + --conversion is needed to extract dates + function to_date(v pljson_element) return date as + begin + if (v.is_string()) then + return standard.to_date(v.get_string(), format_string); + else + raise_application_error(-20110, 'not a date-value'); + end if; + exception + when others then + raise_application_error(-20110, 'Anydata did not contain a date on the format: '||format_string); + end; + + -- alias so that old code doesn't break + function to_date2(v pljson_element) return date as + begin + return to_date(v); + end; + + /* + assumes single base64 string or broken into equal length lines of max 64 or 76 chars + (as specified by RFC-1421 or RFC-2045) + line ending can be CR+NL or NL + */ + function decodeBase64Clob2Blob(p_clob clob) return blob + is + r_blob blob; + clob_size number; + pos number; + c_buf varchar2(32767); + r_buf raw(32767); + v_read_size number; + v_line_size number; + begin + dbms_lob.createtemporary(r_blob, false, dbms_lob.call); + /* + E.I.Sarmas (github.com/dsnz) 2017-12-07 fix for alignment issues + assumes single base64 string or broken into equal length lines of max 64 or 76 followed by CR+NL + as specified by RFC-1421 or RFC-2045 which seem to be the supported ones by Oracle utl_encode + also support single NL instead of CR+NL ! + */ + clob_size := dbms_lob.getlength(p_clob); + v_line_size := 64; + if clob_size >= 65 and dbms_lob.substr(p_clob, 1, 65) = chr(10) then + v_line_size := 65; + elsif clob_size >= 66 and dbms_lob.substr(p_clob, 1, 65) = chr(13) then + v_line_size := 66; + elsif clob_size >= 77 and dbms_lob.substr(p_clob, 1, 77) = chr(10) then + v_line_size := 77; + elsif clob_size >= 78 and dbms_lob.substr(p_clob, 1, 77) = chr(13) then + v_line_size := 78; + end if; + --dbms_output.put_line('decoding in multiples of ' || v_line_size); + v_read_size := floor(32767/v_line_size)*v_line_size; + + pos := 1; + while (pos < clob_size) loop + dbms_lob.read(p_clob, v_read_size, pos, c_buf); + r_buf := utl_encode.base64_decode(utl_raw.cast_to_raw(c_buf)); + dbms_lob.writeappend(r_blob, utl_raw.length(r_buf), r_buf); + pos := pos + v_read_size; + end loop; + return r_blob; + end decodeBase64Clob2Blob; + + /* + encoding in lines of 64 chars ending with CR+NL + */ + function encodeBase64Blob2Clob(p_blob in blob) return clob + is + r_clob clob; + /* E.I.Sarmas (github.com/dsnz) 2017-12-07 NOTE: must be multiple of 48 !!! */ + c_step number := 12000; + c_buf varchar2(32767); + begin + if p_blob is not null then + dbms_lob.createtemporary(r_clob, false, dbms_lob.call); + for i in 0 .. trunc((dbms_lob.getlength(p_blob) - 1)/c_step) loop + c_buf := utl_raw.cast_to_varchar2(utl_encode.base64_encode(dbms_lob.substr(p_blob, c_step, i * c_step + 1))); + /* + E.I.Sarmas (github.com/dsnz) 2017-12-07 fix for alignment issues + must output CR+NL at end always, so will align with the following block and can be decoded correctly + assumes ending in CR+NL + */ + if substr(c_buf, length(c_buf)) != chr(10) then + c_buf := c_buf || CHR(13) || CHR(10); + end if; + /* + dbms_output.put_line( + 'l=' || length(c_buf) || + ' e=' || ascii(substr(c_buf, length(c_buf) - 1)) || ' ' || ascii(substr(c_buf, length(c_buf))) + ); + */ + dbms_lob.writeappend(lob_loc => r_clob, amount => length(c_buf), buffer => c_buf); + end loop; + end if; + return r_clob; + end encodeBase64Blob2Clob; + + --Json Path parser + /* E.I.Sarmas (github.com/dsnz) 2021-12-01 minor path enhancement and more correct enforcement of paths accepted */ + /* + + updated definition of json path expression syntax accepted by PLJSON + + - a path may optionally begin with $ indicating the JSON object to be matched (root) + then it's followed by 0 or more path steps + each step can be an object step or an array step, depending on whether the context item represents a JSON object or a JSON array + + - an object step is a period (.), sometimes read as "dot", followed by an object field name (object property name) + a field name must start with an uppercase or lowercase letter A to Z and contain only such letters or decimal digits (0-9), + or else it must be enclosed in double quotation marks (") + OR + a left bracket ([) followed by a a field name enclosed in single (') or double (") quotes, followed by a right bracket (]) + + - an array step is a left bracket ([) followed by a single numeric index, followed by a right bracket (]) + array indexing is one-based (1, 2, 3,...) + + examples: + $.store.book[0].title + $['store']['book'][0]['title'] + + in latest update + - an object step, beginning with dot (.), now accepts name within double quotes (") + - no longer accepts name beginning with, ending with and including spaces eg. 'd. a name .data' + + - in past, after a dot (.) the field name could start with space or number + and include or end with any number of spaces + now this is not allowed, unquoted field names must begin with an alpha character or _ + and contain only alphanumeric characters + + - path expressions are now compatible with Oracle Basic SQL/JSON Path Expression Syntax + but excluding the optional filter expression and the optional function step at end + + */ + function parsePath(json_path varchar2, base number default 1) return pljson_list as + build_path varchar2(32767) := '['; + buf varchar2(4); + endstring varchar2(1); + indx number := 1; + ret pljson_list; + + procedure next_char as + begin + if (indx <= length(json_path)) then + buf := substr(json_path, indx, 1); + indx := indx + 1; + else + buf := null; + end if; + end; + --skip ws + procedure skipws as begin while (buf in (chr(9), chr(10), chr(13), ' ')) loop next_char; end loop; end; + + begin + -- dbms_output.put_line('parse: ' || json_path); + + -- handle null path and optional '$' at beginning + if json_path is null or substr(json_path, 1, 1) = '$' then + indx := 2; + next_char(); + else + if substr(json_path, 1, 1) = '[' then + next_char(); + else + buf := '.'; + end if; + end if; + + while (buf is not null) loop + -- dbms_output.put_line(build_path || ' + ' || buf); + + if (buf = '.') then + next_char(); + if (buf is null) then raise_application_error(-20110, 'JSON Path parse error: . is not a valid json_path end'); end if; + /* E.I.Sarmas (github.com/dsnz) 2021-10-31 removed space or number as acceptable character */ + if (not regexp_like(buf, '^["[:alpha:]\_]+', 'c') ) then + -- dbms_output.put_line(build_path || ' + ' || buf); + raise_application_error(-20110, 'JSON Path parse error: alpha or _ character expected at position '||indx); + end if; + + if (build_path != '[') then build_path := build_path || ','; end if; + build_path := build_path || '"'; + /* E.I.Sarmas (github.com/dsnz) 2021-10-31 accept name with any characters quoted within "" after . */ + if buf = '"' then + next_char(); + while buf is not null and buf != '"' loop + build_path := build_path || buf; + next_char(); + end loop; + if buf is null then + raise_application_error(-20110, 'JSON Path parse error: premature json_path end, missing ending "'); + end if; + next_char(); + else + /* E.I.Sarmas (github.com/dsnz) 2021-10-31 removed space as acceptable character */ + while (regexp_like(buf, '^[[:alnum:]\_]+', 'c') ) loop + build_path := build_path || buf; + next_char(); + end loop; + end if; + build_path := build_path || '"'; + + elsif (buf = '[') then + next_char(); + skipws(); + if (buf is null) then raise_application_error(-20110, 'JSON Path parse error: [ is not a valid json_path end'); end if; + -- array step + if (buf in ('1','2','3','4','5','6','7','8','9') or (buf = '0' and base = 0)) then + if (build_path != '[') then build_path := build_path || ','; end if; + while (buf in ('0','1','2','3','4','5','6','7','8','9')) loop + build_path := build_path || buf; + next_char(); + end loop; + -- object step using [] syntax + elsif (regexp_like(buf, '^(\"|\'')', 'c')) then + endstring := buf; + if (build_path != '[') then build_path := build_path || ','; end if; + build_path := build_path || '"'; + next_char(); + if (buf is null) then raise_application_error(-20110, 'JSON Path parse error: premature json_path end'); end if; + while (buf != endstring) loop + build_path := build_path || buf; + next_char(); + if (buf is null) then raise_application_error(-20110, 'JSON Path parse error: premature json_path end'); end if; + if (buf = '\') then + next_char(); + build_path := build_path || '\' || buf; + next_char(); + end if; + end loop; + build_path := build_path || '"'; + next_char(); + else + raise_application_error(-20110, 'JSON Path parse error: expected a string or a positive integer at '||indx); + end if; + skipws(); + if (buf is null) then raise_application_error(-20110, 'JSON Path parse error: premature json_path end'); end if; + if (buf != ']') then raise_application_error(-20110, 'JSON Path parse error: no array ending found. found: '|| buf); end if; + next_char(); + skipws(); + + /* E.I.Sarmas (github.com/dsnz) 2021-10-31 obsolete, repeats code after ".", handled by assuming a dummy "." at start + elsif (build_path = '[') then + if (not regexp_like(buf, '^[[:alnum:]\_ ]+', 'c') ) then + raise_application_error(-20110, 'JSON Path parse error: alpha-numeric character or space expected at position '||indx); + end if; + build_path := build_path || '"'; + while (regexp_like(buf, '^[[:alnum:]\_ ]+', 'c') ) loop + build_path := build_path || buf; + next_char(); + end loop; + build_path := build_path || '"'; + */ + else + raise_application_error(-20110, 'JSON Path parse error: expected . or [ found '|| buf || ' at position '|| indx); + end if; + + end loop; + + build_path := build_path || ']'; + build_path := replace(replace(replace(replace(replace(build_path, chr(9), '\t'), chr(10), '\n'), chr(13), '\f'), chr(8), '\b'), chr(14), '\r'); + -- dbms_output.put_line('parse= ' || build_path); + + ret := pljson_list(build_path); + if (base != 1) then + --fix base 0 to base 1 + declare + elem pljson_element; + begin + for i in 1 .. ret.count loop + elem := ret.get(i); + if (elem.is_number()) then + ret.replace(i, elem.get_number()+1); + end if; + end loop; + end; + end if; + + return ret; + end parsePath; + + --JSON pre-parsed path getters + /* contributed by @asfernandes */ + function get_json_element(obj pljson, path pljson_list) return pljson_element as + path_segments pljson_path := pljson_path(); + ret pljson_element; + begin + if (path.count = 0) then + return obj; + end if; + + for i in 1 .. path.count loop + path_segments.extend; + if (path.get(i).is_number()) then + path_segments(path_segments.count) := pljson_path_segment(path.get(i).get_number(), null); + else + path_segments(path_segments.count) := pljson_path_segment(null, path.get(i).get_string()); + end if; + end loop; + + obj.get_internal_path(path_segments, 1, ret); + return ret; + exception + when scanner_exception then raise; + when parser_exception then raise; + when jext_exception then raise; + when others then return null; + end get_json_element; + + function get_string(obj pljson, path pljson_list) return varchar2 as + temp pljson_element; + begin + temp := get_json_element(obj, path); + if (temp is null or not temp.is_string()) then + return null; + else + return temp.get_string(); + end if; + end; + + function get_number(obj pljson, path pljson_list) return number as + temp pljson_element; + begin + temp := get_json_element(obj, path); + if (temp is null or not temp.is_number()) then + return null; + else + return temp.get_number(); + end if; + end; + + function get_double(obj pljson, path pljson_list) return binary_double as + temp pljson_element; + begin + temp := get_json_element(obj, path); + if (temp is null or not temp.is_number()) then + return null; + else + return temp.get_double(); + end if; + end; + + function get_json(obj pljson, path pljson_list) return pljson as + temp pljson_element; + begin + temp := get_json_element(obj, path); + if (temp is null or not temp.is_object()) then + return null; + else + return treat(temp as pljson); + end if; + end; + + function get_json_list(obj pljson, path pljson_list) return pljson_list as + temp pljson_element; + begin + temp := get_json_element(obj, path); + if (temp is null or not temp.is_array()) then + return null; + else + return treat(temp as pljson_list); + end if; + end; + + function get_bool(obj pljson, path pljson_list) return boolean as + temp pljson_element; + begin + temp := get_json_element(obj, path); + if (temp is null or not temp.is_bool()) then + return null; + else + return temp.get_bool(); + end if; + end; + + function get_date(obj pljson, path pljson_list) return date as + temp pljson_element; + begin + temp := get_json_element(obj, path); + if (temp is null or not is_date(temp)) then + return null; + else + return pljson_ext.to_date(temp); + end if; + end; + + --JSON Path getters + --saved original code, in case of future bug troubleshooting + function get_json_element_original(obj pljson, v_path varchar2, base number default 1) return pljson_element as + path pljson_list; + ret pljson_element; + o pljson; l pljson_list; + begin + path := parsePath(v_path, base); + ret := obj; + if (path.count = 0) then return ret; end if; + + for i in 1 .. path.count loop + if (path.get(i).is_string()) then + --string fetch only on json + ------o := pljson(ret); + ------ret := o.get(path.get(i).get_string()); + /* E.I.Sarmas (github.com/dsnz) 2020-04-18 use inheritance and avoid treat() */ + ret := ret.get(path.get(i).get_string()); + --experimental, ignore + --ret := get_piece(o, path.get(i).get_string()); + else + --number fetch on json and json_list + if (ret.is_array()) then + ------l := pljson_list(ret); + ------ret := l.get(path.get(i).get_number()); + /* E.I.Sarmas (github.com/dsnz) 2020-04-18 use inheritance and avoid treat() */ + ret := ret.get(path.get(i).get_number()); + --experimental, ignore + --ret := get_piece(l, path.get(i).get_number()); + else + ------o := pljson(ret); + ------l := o.get_values(); + ------ret := l.get(path.get(i).get_number()); + /* E.I.Sarmas (github.com/dsnz) 2020-04-18 use inheritance and avoid treat() */ + ret := ret.get(path.get(i).get_number()); + --experimental, ignore + --ret := get_piece(l, path.get(i).get_number()); + end if; + end if; + end loop; + + return ret; + exception + when scanner_exception then raise; + when parser_exception then raise; + when jext_exception then raise; + when others then return null; + end get_json_element_original; + + function get_json_element(obj pljson, v_path varchar2, base number default 1) return pljson_element as + path pljson_list; + begin + path := parsePath(v_path, base); + return get_json_element(obj, path); + end get_json_element; + + function get_string(obj pljson, path varchar2, base number default 1) return varchar2 as + temp pljson_element; + begin + temp := get_json_element(obj, path, base); + if (temp is null or not temp.is_string()) then + return null; + else + return temp.get_string(); + end if; + end; + + function get_number(obj pljson, path varchar2, base number default 1) return number as + temp pljson_element; + begin + temp := get_json_element(obj, path, base); + if (temp is null or not temp.is_number()) then + return null; + else + return temp.get_number(); + end if; + end; + + /* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */ + function get_double(obj pljson, path varchar2, base number default 1) return binary_double as + temp pljson_element; + begin + temp := get_json_element(obj, path, base); + if (temp is null or not temp.is_number()) then + return null; + else + return temp.get_double(); + end if; + end; + + function get_json(obj pljson, path varchar2, base number default 1) return pljson as + temp pljson_element; + begin + temp := get_json_element(obj, path, base); + if (temp is null or not temp.is_object()) then + return null; + else + return treat(temp as pljson); + end if; + end; + + function get_json_list(obj pljson, path varchar2, base number default 1) return pljson_list as + temp pljson_element; + begin + temp := get_json_element(obj, path, base); + if (temp is null or not temp.is_array()) then + return null; + else + return treat(temp as pljson_list); + end if; + end; + + function get_bool(obj pljson, path varchar2, base number default 1) return boolean as + temp pljson_element; + begin + temp := get_json_element(obj, path, base); + if (temp is null or not temp.is_bool()) then + return null; + else + return temp.get_bool(); + end if; + end; + + function get_date(obj pljson, path varchar2, base number default 1) return date as + temp pljson_element; + begin + temp := get_json_element(obj, path, base); + if (temp is null or not is_date(temp)) then + return null; + else + return pljson_ext.to_date(temp); + end if; + end; + + /* JSON pre-parsed path putter internal function */ + procedure put_internal_preparsed(obj in out nocopy pljson, path pljson_list, elem pljson_element) as + path_segments pljson_path := pljson_path(); + dummy boolean; + begin + if (path.count = 0) then raise_application_error(-20110, 'PLJSON_EXT put error: cannot put with empty string.'); end if; + + for i in 1 .. path.count loop + path_segments.extend; + + if (path.get(i).is_number()) then + path_segments(path_segments.count) := pljson_path_segment(path.get(i).get_number(), null); + else + path_segments(path_segments.count) := pljson_path_segment(null, path.get(i).get_string()); + end if; + end loop; + + dummy := obj.put_internal_path(path_segments, elem, 1); + end; + + /* JSON Path putter internal function */ + --saved original code, in case of future bug troubleshooting + procedure put_internal_original(obj in out nocopy pljson, v_path varchar2, elem pljson_element, base number) as + val pljson_element := elem; + path pljson_list; + backreference pljson_list := pljson_list(); + + keyval pljson_element; keynum number; keystring varchar2(4000); + temp pljson_element := obj; + obj_temp pljson; + list_temp pljson_list; + inserter pljson_element; + begin + path := pljson_ext.parsePath(v_path, base); + if (path.count = 0) then raise_application_error(-20110, 'PLJSON_EXT put error: cannot put with empty string.'); end if; + + --build backreference + for i in 1 .. path.count loop + --backreference.print(false); + keyval := path.get(i); + if (keyval.is_number()) then + --number index + keynum := keyval.get_number(); + if ((not temp.is_object()) and (not temp.is_array())) then + if (val is null) then return; end if; + backreference.remove_last; + temp := pljson_list(); + backreference.append(temp); + end if; + + if (temp.is_object()) then + obj_temp := pljson(temp); + if (obj_temp.count < keynum) then + if (val is null) then return; end if; + raise_application_error(-20110, 'PLJSON_EXT put error: access object with too few members.'); + end if; + temp := obj_temp.get(keynum); + else + list_temp := pljson_list(temp); + if (list_temp.count < keynum) then + if (val is null) then return; end if; + --raise error or quit if val is null + for i in list_temp.count+1 .. keynum loop + list_temp.append(pljson_null()); + end loop; + backreference.remove_last; + backreference.append(list_temp); + end if; + + temp := list_temp.get(keynum); + end if; + else + --string index + keystring := keyval.get_string(); + if (not temp.is_object()) then + --backreference.print; + if (val is null) then return; end if; + backreference.remove_last; + temp := pljson(); + backreference.append(temp); + --raise_application_error(-20110, 'PLJSON_EXT put error: trying to access a non object with a string.'); + end if; + obj_temp := pljson(temp); + temp := obj_temp.get(keystring); + end if; + + if (temp is null) then + if (val is null) then return; end if; + --what to expect? + keyval := path.get(i+1); + if (keyval is not null and keyval.is_number()) then + temp := pljson_list(); + else + temp := pljson(); + end if; + end if; + backreference.append(temp); + end loop; + + -- backreference.print(false); + -- path.print(false); + + --use backreference and path together + inserter := val; + for i in reverse 1 .. backreference.count loop + -- inserter.print(false); + if ( i = 1 ) then + keyval := path.get(1); + if (keyval.is_string()) then + keystring := keyval.get_string(); + else + keynum := keyval.get_number(); + declare + t1 pljson_element := obj.get(keynum); + begin + keystring := t1.mapname; + end; + end if; + if (inserter is null) then obj.remove(keystring); else obj.put(keystring, inserter); end if; + else + temp := backreference.get(i-1); + if (temp.is_object()) then + keyval := path.get(i); + obj_temp := pljson(temp); + if (keyval.is_string()) then + keystring := keyval.get_string(); + else + keynum := keyval.get_number(); + declare + t1 pljson_element := obj_temp.get(keynum); + begin + keystring := t1.mapname; + end; + end if; + if (inserter is null) then + obj_temp.remove(keystring); + if (obj_temp.count > 0) then inserter := obj_temp; end if; + else + obj_temp.put(keystring, inserter); + inserter := obj_temp; + end if; + else + --array only number + keynum := path.get(i).get_number(); + list_temp := pljson_list(temp); + list_temp.remove(keynum); + if (not inserter is null) then + list_temp.append(inserter, keynum); + inserter := list_temp; + else + if (list_temp.count > 0) then inserter := list_temp; end if; + end if; + end if; + end if; + + end loop; + + end put_internal_original; + + procedure put_internal(obj in out nocopy pljson, v_path varchar2, elem pljson_element, base number) as + path pljson_list; + begin + path := pljson_ext.parsePath(v_path, base); + put_internal_preparsed(obj, path, elem); + end put_internal; + + /* JSON pre-parsed path putters */ + procedure put(obj in out nocopy pljson, path pljson_list, elem varchar2) as + begin + if elem is null then + put_internal_preparsed(obj, path, pljson_null()); + else + put_internal_preparsed(obj, path, pljson_string(elem)); + end if; + end; + + procedure put(obj in out nocopy pljson, path pljson_list, elem number) as + begin + if elem is null then + put_internal_preparsed(obj, path, pljson_null()); + else + put_internal_preparsed(obj, path, pljson_number(elem)); + end if; + end; + + procedure put(obj in out nocopy pljson, path pljson_list, elem binary_double) as + begin + if elem is null then + put_internal_preparsed(obj, path, pljson_null()); + else + put_internal_preparsed(obj, path, pljson_number(elem)); + end if; + end; + + procedure put(obj in out nocopy pljson, path pljson_list, elem pljson) as + begin + if elem is null then + put_internal_preparsed(obj, path, pljson_null()); + else + put_internal_preparsed(obj, path, elem); + end if; + end; + + procedure put(obj in out nocopy pljson, path pljson_list, elem pljson_list) as + begin + if elem is null then + put_internal_preparsed(obj, path, pljson_null()); + else + put_internal_preparsed(obj, path, elem); + end if; + end; + + procedure put(obj in out nocopy pljson, path pljson_list, elem boolean) as + begin + if elem is null then + put_internal_preparsed(obj, path, pljson_null()); + else + put_internal_preparsed(obj, path, pljson_bool(elem)); + end if; + end; + + procedure put(obj in out nocopy pljson, path pljson_list, elem pljson_element) as + begin + if elem is null then + put_internal_preparsed(obj, path, pljson_null()); + else + put_internal_preparsed(obj, path, elem); + end if; + end; + + procedure put(obj in out nocopy pljson, path pljson_list, elem date) as + begin + if elem is null then + put_internal_preparsed(obj, path, pljson_null()); + else + put_internal_preparsed(obj, path, pljson_ext.to_json_string(elem)); + end if; + end; + + /* JSON Path putters */ + procedure put(obj in out nocopy pljson, path varchar2, elem varchar2, base number default 1) as + begin + if elem is null then + put_internal(obj, path, pljson_null(), base); + else + put_internal(obj, path, pljson_string(elem), base); + end if; + end; + + procedure put(obj in out nocopy pljson, path varchar2, elem number, base number default 1) as + begin + if elem is null then + put_internal(obj, path, pljson_null(), base); + else + put_internal(obj, path, pljson_number(elem), base); + end if; + end; + + /* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */ + procedure put(obj in out nocopy pljson, path varchar2, elem binary_double, base number default 1) as + begin + if elem is null then + put_internal(obj, path, pljson_null(), base); + else + put_internal(obj, path, pljson_number(elem), base); + end if; + end; + + procedure put(obj in out nocopy pljson, path varchar2, elem pljson, base number default 1) as + begin + if elem is null then + put_internal(obj, path, pljson_null(), base); + else + put_internal(obj, path, elem, base); + end if; + end; + + procedure put(obj in out nocopy pljson, path varchar2, elem pljson_list, base number default 1) as + begin + if elem is null then + put_internal(obj, path, pljson_null(), base); + else + put_internal(obj, path, elem, base); + end if; + end; + + procedure put(obj in out nocopy pljson, path varchar2, elem boolean, base number default 1) as + begin + if elem is null then + put_internal(obj, path, pljson_null(), base); + else + put_internal(obj, path, pljson_bool(elem), base); + end if; + end; + + procedure put(obj in out nocopy pljson, path varchar2, elem pljson_element, base number default 1) as + begin + if elem is null then + put_internal(obj, path, pljson_null(), base); + else + put_internal(obj, path, elem, base); + end if; + end; + + procedure put(obj in out nocopy pljson, path varchar2, elem date, base number default 1) as + begin + if elem is null then + put_internal(obj, path, pljson_null(), base); + else + put_internal(obj, path, pljson_ext.to_json_string(elem), base); + end if; + end; + + procedure remove(obj in out nocopy pljson, path pljson_list) as + begin + pljson_ext.put_internal_preparsed(obj, path, null); + end remove; + + procedure remove(obj in out nocopy pljson, path varchar2, base number default 1) as + begin + pljson_ext.put_internal(obj, path, null, base); + --if (json_ext.get_json_element(obj, path) is not null) then + --end if; + end remove; + + --Pretty print with JSON Path + function pp(obj pljson, v_path varchar2) return varchar2 as + json_part pljson_element; + begin + json_part := pljson_ext.get_json_element(obj, v_path); + if (json_part is null) then + return ''; + else + return pljson_printer.pretty_print_any(json_part); --escapes a possible internal string + end if; + end pp; + + procedure pp(obj pljson, v_path varchar2) as --using dbms_output.put_line + begin + dbms_output.put_line(pp(obj, v_path)); + end pp; + + -- spaces = false! + procedure pp_htp(obj pljson, v_path varchar2) as --using htp.print + json_part pljson_element; + begin + json_part := pljson_ext.get_json_element(obj, v_path); + if (json_part is null) then + htp.print; + else + htp.print(pljson_printer.pretty_print_any(json_part, false)); + end if; + end pp_htp; + + function base64(binarydata blob) return pljson_list as + obj pljson_list := pljson_list(); + c clob; + + v_clob_offset number := 1; + v_lang_context number := dbms_lob.DEFAULT_LANG_CTX; + v_amount number; + begin + --dbms_lob.createtemporary(c, false, dbms_lob.call); + c := encodeBase64Blob2Clob(binarydata); + v_amount := dbms_lob.getlength(c); + v_clob_offset := 1; + --dbms_output.put_line('v_amount: '||v_amount); + while (v_clob_offset < v_amount) loop + --dbms_output.put_line(v_offset); + --temp := ; + --dbms_output.put_line('size: '||length(temp)); + obj.append(dbms_lob.substr(c, 4000, v_clob_offset)); + v_clob_offset := v_clob_offset + 4000; + end loop; + dbms_lob.freetemporary(c); + --dbms_output.put_line(obj.count); + --dbms_output.put_line(obj.get_last().to_char); + return obj; + + end base64; + + function base64(l pljson_list) return blob as + c clob; + b_ret blob; + + v_lang_context number := dbms_lob.DEFAULT_LANG_CTX; + -- v_amount number; + begin + dbms_lob.createtemporary(c, false, dbms_lob.call); + for i in 1 .. l.count loop + dbms_lob.append(c, l.get(i).get_string()); + end loop; + -- v_amount := dbms_lob.getlength(c); + -- dbms_output.put_line('L C'||v_amount); + b_ret := decodeBase64Clob2Blob(c); + dbms_lob.freetemporary(c); + return b_ret; + end base64; + + function encode(binarydata blob) return pljson_string as + obj pljson_string; + c clob; + v_lang_context number := dbms_lob.DEFAULT_LANG_CTX; + begin + dbms_lob.createtemporary(c, false, dbms_lob.call); + c := encodeBase64Blob2Clob(binarydata); + obj := pljson_string(c); + + --dbms_output.put_line(obj.count); + --dbms_output.put_line(obj.get_last().to_char); + /* dbms_lob.freetemporary(c); */ + return obj; + end encode; + + function decode(v pljson_string) return blob as + c clob; + b_ret blob; + + v_lang_context number := dbms_lob.DEFAULT_LANG_CTX; + -- v_amount number; + begin + /* + dbms_lob.createtemporary(c, false, dbms_lob.call); + v.get_string(c); + */ + c := v.get_clob(); + -- v_amount := dbms_lob.getlength(c); + -- dbms_output.put_line('L C'||v_amount); + b_ret := decodeBase64Clob2Blob(c); + /* dbms_lob.freetemporary(c); */ + return b_ret; + + end decode; + + procedure blob2clob(b blob, c out clob, charset varchar2 default 'UTF8') as + v_dest_offset number := 1; + v_src_offset number := 1; + v_lang_context number := dbms_lob.DEFAULT_LANG_CTX; + v_warning number := dbms_lob.NO_WARNING; + begin + dbms_lob.createtemporary(c, false, dbms_lob.call); + dbms_lob.converttoclob( + dest_lob => c, + src_blob => b, + amount => dbms_lob.LOBMAXSIZE, + dest_offset => v_dest_offset, + src_offset => v_src_offset, + blob_csid => nls_charset_id(charset), + lang_context => v_lang_context, + warning => v_warning); + end; +end pljson_ext; +/ +show err + +-- --- pljson_element.type.impl (body) --- +create or replace type body pljson_element as + + constructor function pljson_element return self as result as + begin + raise_application_error(-20000, 'pljson_element is not instantiable'); + end; + + /* all the is_ methods can + test against typeval or + return false and be overriden in children + */ + member function is_object return boolean as + begin + return false; + end; + + member function is_array return boolean as + begin + return false; + end; + + member function is_string return boolean as + begin + return false; + end; + + member function is_number return boolean as + begin + return false; + end; + + member function is_bool return boolean as + begin + return false; + end; + + member function is_null return boolean as + begin + return false; + end; + + member function get_type return varchar2 as + begin + case self.typeval + when 1 then return 'object'; + when 2 then return 'array'; + when 3 then return 'string'; + when 4 then return 'number'; + when 5 then return 'bool'; + when 6 then return 'null'; + end case; + + return 'unknown type'; + end; + + member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2 as + begin + raise_application_error(-20002, 'value_of() method should be overriden'); + end; + + /* + member methods to remove need for treat() + */ + member function get_string(max_byte_size number default null, max_char_size number default null) return varchar2 as + begin + raise_application_error(-20003, 'get_string() method is not supported by object of type:' || get_type()); + end; + + member function get_clob return clob as + begin + raise_application_error(-20004, 'get_clob() method is not supported by object of type:' || get_type()); + end; + + member function get_number return number as + begin + raise_application_error(-20005, 'get_number() method is not supported by object of type:' || get_type()); + end; + + member function get_double return binary_double as + begin + raise_application_error(-20006, 'get_double() method is not supported by object of type:' || get_type()); + end; + + member function is_number_repr_number return boolean as + begin + raise_application_error(-20008, 'is_number_repr_number() method is not supported by object of type:' || get_type()); + end; + + member function is_number_repr_double return boolean as + begin + raise_application_error(-20009, 'is_number_repr_double() method is not supported by object of type:' || get_type()); + end; + + member function get_bool return boolean as + begin + raise_application_error(-20007, 'get_bool() method is not supported by object of type:' || get_type()); + end; + + member function count return number as + begin + raise_application_error(-20012, 'count() method is not supported by object of type:' || get_type()); + end; + + member function get(pair_name varchar2) return pljson_element as + begin + raise_application_error(-20020, 'get(name) method is not supported by object of type:' || get_type()); + end; + + member function get(position pls_integer) return pljson_element as + begin + raise_application_error(-20021, 'get(position) method is not supported by object of type:' || get_type()); + end; + + member function path(json_path varchar2, base number default 1) return pljson_element as + begin + raise_application_error(-20010, 'path() method is not supported by object of type:' || get_type()); + end; + + /* output methods */ + member function to_char(spaces boolean default true, chars_per_line number default 0) return varchar2 as + begin + if (spaces is null) then + return pljson_printer.pretty_print_any(self, line_length => chars_per_line); + else + return pljson_printer.pretty_print_any(self, spaces, line_length => chars_per_line); + end if; + end; + + member procedure to_clob(self in pljson_element, buf in out nocopy clob, spaces boolean default false, chars_per_line number default 0, erase_clob boolean default true) as + begin + if (spaces is null) then + pljson_printer.pretty_print_any(self, false, buf, line_length => chars_per_line, erase_clob => erase_clob); + else + pljson_printer.pretty_print_any(self, spaces, buf, line_length => chars_per_line, erase_clob => erase_clob); + end if; + end; + + member procedure print(self in pljson_element, spaces boolean default true, chars_per_line number default 8192, jsonp varchar2 default null) as --32512 is the real maximum in sqldeveloper + my_clob clob; + begin + dbms_lob.createtemporary(my_clob, true); + pljson_printer.pretty_print_any(self, spaces, my_clob, case when (chars_per_line>32512) then 32512 else chars_per_line end); + pljson_printer.dbms_output_clob(my_clob, pljson_printer.newline_char, jsonp); + dbms_lob.freetemporary(my_clob); + end; + + member procedure htp(self in pljson_element, spaces boolean default false, chars_per_line number default 0, jsonp varchar2 default null) as + my_clob clob; + begin + dbms_lob.createtemporary(my_clob, true); + pljson_printer.pretty_print_any(self, spaces, my_clob, chars_per_line); + pljson_printer.htp_output_clob(my_clob, jsonp); + dbms_lob.freetemporary(my_clob); + end; + + /* private method for internal use, not part of the API, contributed by @asfernandes */ + member procedure get_internal_path(self in pljson_element, path pljson_path, path_position pls_integer, ret out nocopy pljson_element) as + begin + raise_application_error(-20010, 'path() method is not supported by object of type:' || get_type()); + end; + + /* private method for internal use, not part of the API, contributed by @asfernandes */ + member function put_internal_path(self in out nocopy pljson_element, path pljson_path, elem pljson_element, path_position pls_integer) return boolean as + begin + return false; + end; +end; +/ +show err + +-- --- pljson_list.type.impl (body) --- +create or replace type body pljson_list as + + /* constructors */ + constructor function pljson_list return self as result as + begin + self.list_data := pljson_element_array(); + self.typeval := 2; + + --self.object_id := pljson_object_cache.next_id; + return; + end; + + constructor function pljson_list(str varchar2) return self as result as + begin + self := pljson_parser.parse_list(str); + --self.typeval := 2; + return; + end; + + constructor function pljson_list(str clob) return self as result as + begin + self := pljson_parser.parse_list(str); + --self.typeval := 2; + return; + end; + + constructor function pljson_list(str blob, charset varchar2 default 'UTF8') return self as result as + c_str clob; + begin + pljson_ext.blob2clob(str, c_str, charset); + self := pljson_parser.parse_list(c_str); + --self.typeval := 2; + return; + end; + + constructor function pljson_list(str_array pljson_varray) return self as result as + begin + self.list_data := pljson_element_array(); + self.typeval := 2; + for i in str_array.FIRST .. str_array.LAST loop + append(str_array(i)); + end loop; + + --self.object_id := pljson_object_cache.next_id; + return; + end; + + constructor function pljson_list(num_array pljson_narray) return self as result as + begin + self.list_data := pljson_element_array(); + self.typeval := 2; + for i in num_array.FIRST .. num_array.LAST loop + append(num_array(i)); + end loop; + + --self.object_id := pljson_object_cache.next_id; + return; + end; + + constructor function pljson_list(elem pljson_element) return self as result as + begin + self := treat(elem as pljson_list); + --self.typeval := 2; + return; + end; + + constructor function pljson_list(elem_array pljson_element_array) return self as result as + begin + self.list_data := elem_array; + self.typeval := 2; + return; + end; + + overriding member function is_array return boolean as + begin + return true; + end; + + overriding member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2 as + begin + return 'json array'; + end; + + /* list management */ + member procedure append(self in out nocopy pljson_list, elem pljson_element, position pls_integer default null) as + indx pls_integer; + --insert_value pljson_element; + begin + /* + insert_value := elem; + if insert_value is null then + insert_value := pljson_null(); + end if; + */ + if (position is null or position > self.count) then --end of list + indx := self.count + 1; + self.list_data.extend(1); + elsif (position < 1) then --new first + indx := self.count; + self.list_data.extend(1); + for x in reverse 1 .. indx loop + self.list_data(x+1) := self.list_data(x); + end loop; + indx := 1; + --self.list_data(1) := insert_value; + else + indx := self.count; + self.list_data.extend(1); + for x in reverse position .. indx loop + self.list_data(x+1) := self.list_data(x); + end loop; + indx := position; + --self.list_data(position) := insert_value; + end if; + + if elem is not null then + self.list_data(indx) := elem; + else + self.list_data(indx) := pljson_null(); + end if; + end; + + member procedure append(self in out nocopy pljson_list, elem varchar2, position pls_integer default null) as + begin + if (elem is null and pljson_parser.empty_string_as_null) then + append(pljson_null(), position); + else + append(pljson_string(elem), position); + end if; + end; + + member procedure append(self in out nocopy pljson_list, elem clob, position pls_integer default null) as + begin + if (elem is null) then + append(pljson_null(), position); + else + append(pljson_string(elem), position); + end if; + end; + + member procedure append(self in out nocopy pljson_list, elem number, position pls_integer default null) as + begin + if (elem is null) then + append(pljson_null(), position); + else + append(pljson_number(elem), position); + end if; + end; + + /* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */ + member procedure append(self in out nocopy pljson_list, elem binary_double, position pls_integer default null) as + begin + if (elem is null) then + append(pljson_null(), position); + else + append(pljson_number(elem), position); + end if; + end; + + member procedure append(self in out nocopy pljson_list, elem boolean, position pls_integer default null) as + begin + if (elem is null) then + append(pljson_null(), position); + else + append(pljson_bool(elem), position); + end if; + end; + + member procedure append(self in out nocopy pljson_list, elem pljson_list, position pls_integer default null) as + begin + if (elem is null) then + append(pljson_null(), position); + else + append(treat(elem as pljson_element), position); + end if; + end; + + member procedure replace(self in out nocopy pljson_list, position pls_integer, elem pljson_element) as + insert_value pljson_element; + indx number; + begin + insert_value := elem; + if insert_value is null then + insert_value := pljson_null(); + end if; + if (position > self.count) then --end of list + indx := self.count + 1; + self.list_data.extend(1); + self.list_data(indx) := insert_value; + elsif (position < 1) then --maybe an error message here + null; + else + self.list_data(position) := insert_value; + end if; + end; + + member procedure replace(self in out nocopy pljson_list, position pls_integer, elem varchar2) as + begin + if (elem is null and pljson_parser.empty_string_as_null) then + replace(position, pljson_null()); + else + replace(position, pljson_string(elem)); + end if; + end; + + member procedure replace(self in out nocopy pljson_list, position pls_integer, elem clob) as + begin + if (elem is null) then + replace(position, pljson_null()); + else + replace(position, pljson_string(elem)); + end if; + end; + + member procedure replace(self in out nocopy pljson_list, position pls_integer, elem number) as + begin + if (elem is null) then + replace(position, pljson_null()); + else + replace(position, pljson_number(elem)); + end if; + end; + + /* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */ + member procedure replace(self in out nocopy pljson_list, position pls_integer, elem binary_double) as + begin + if (elem is null) then + replace(position, pljson_null()); + else + replace(position, pljson_number(elem)); + end if; + end; + + member procedure replace(self in out nocopy pljson_list, position pls_integer, elem boolean) as + begin + if (elem is null) then + replace(position, pljson_null()); + else + replace(position, pljson_bool(elem)); + end if; + end; + + member procedure replace(self in out nocopy pljson_list, position pls_integer, elem pljson_list) as + begin + if (elem is null) then + replace(position, pljson_null()); + else + replace(position, treat(elem as pljson_element)); + end if; + end; + + member procedure remove(self in out nocopy pljson_list, position pls_integer) as + begin + if (position is null or position < 1 or position > self.count) then return; end if; + for x in (position+1) .. self.count loop + self.list_data(x-1) := self.list_data(x); + end loop; + self.list_data.trim(1); + end; + + member procedure remove_first(self in out nocopy pljson_list) as + begin + for x in 2 .. self.count loop + self.list_data(x-1) := self.list_data(x); + end loop; + if (self.count > 0) then + self.list_data.trim(1); + end if; + end; + + member procedure remove_last(self in out nocopy pljson_list) as + begin + if (self.count > 0) then + self.list_data.trim(1); + end if; + end; + + overriding member function count return number as + begin + return self.list_data.count; + end; + + overriding member function get(position pls_integer) return pljson_element as + begin + if (self.count >= position and position > 0) then + return self.list_data(position); + end if; + return null; -- do not throw error, just return null + end; + + member function get_string(position pls_integer) return varchar2 as + elem pljson_element := get(position); + begin + if elem is not null and elem is of (pljson_string) then + return elem.get_string(); + end if; + return null; + end; + + member function get_clob(position pls_integer) return clob as + elem pljson_element := get(position); + begin + if elem is not null and elem is of (pljson_string) then + return elem.get_clob(); + end if; + return null; + end; + + member function get_number(position pls_integer) return number as + elem pljson_element := get(position); + begin + if elem is not null and elem is of (pljson_number) then + return elem.get_number(); + end if; + return null; + end; + + member function get_double(position pls_integer) return binary_double as + elem pljson_element := get(position); + begin + if elem is not null and elem is of (pljson_number) then + return elem.get_double(); + end if; + return null; + end; + + member function get_bool(position pls_integer) return boolean as + elem pljson_element := get(position); + begin + if elem is not null and elem is of (pljson_bool) then + return elem.get_bool(); + end if; + return null; + end; + + member function get_pljson_list(position pls_integer) return pljson_list as + elem pljson_element := get(position); + begin + if elem is not null and elem is of (pljson_list) then + return treat(elem as pljson_list); + end if; + return null; + end; + + member function head return pljson_element as + begin + if (self.count > 0) then + return self.list_data(self.list_data.first); + end if; + return null; -- do not throw error, just return null + end; + + member function last return pljson_element as + begin + if (self.count > 0) then + return self.list_data(self.list_data.last); + end if; + return null; -- do not throw error, just return null + end; + + member function tail return pljson_list as + t pljson_list; + begin + if (self.count > 0) then + t := self; --pljson_list(self); + t.remove(1); + return t; + else + return pljson_list(); + end if; + end; + + /* json path */ + overriding member function path(json_path varchar2, base number default 1) return pljson_element as + cp pljson_list := self; + begin + return pljson_ext.get_json_element(pljson(cp), json_path, base); + end path; + + /* json path_put */ + member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem pljson_element, base number default 1) as + objlist pljson; + jp pljson_list := pljson_ext.parsePath(json_path, base); + begin + while (jp.head().get_number() > self.count) loop + self.append(pljson_null()); + end loop; + + objlist := pljson(self); + pljson_ext.put(objlist, json_path, elem, base); + self := objlist.get_values; + end path_put; + + member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem varchar2, base number default 1) as + objlist pljson; + jp pljson_list := pljson_ext.parsePath(json_path, base); + begin + while (jp.head().get_number() > self.count) loop + self.append(pljson_null()); + end loop; + + objlist := pljson(self); + if (elem is null and pljson_parser.empty_string_as_null) then + pljson_ext.put(objlist, json_path, pljson_null(), base); + else + pljson_ext.put(objlist, json_path, elem, base); + end if; + self := objlist.get_values; + end path_put; + + member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem clob, base number default 1) as + objlist pljson; + jp pljson_list := pljson_ext.parsePath(json_path, base); + begin + while (jp.head().get_number() > self.count) loop + self.append(pljson_null()); + end loop; + + objlist := pljson(self); + if (elem is null) then + pljson_ext.put(objlist, json_path, pljson_null(), base); + else + pljson_ext.put(objlist, json_path, elem, base); + end if; + self := objlist.get_values; + end path_put; + + member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem number, base number default 1) as + objlist pljson; + jp pljson_list := pljson_ext.parsePath(json_path, base); + begin + while (jp.head().get_number() > self.count) loop + self.append(pljson_null()); + end loop; + + objlist := pljson(self); + if (elem is null) then + pljson_ext.put(objlist, json_path, pljson_null(), base); + else + pljson_ext.put(objlist, json_path, elem, base); + end if; + self := objlist.get_values; + end path_put; + + /* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */ + member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem binary_double, base number default 1) as + objlist pljson; + jp pljson_list := pljson_ext.parsePath(json_path, base); + begin + while (jp.head().get_number() > self.count) loop + self.append(pljson_null()); + end loop; + + objlist := pljson(self); + if (elem is null) then + pljson_ext.put(objlist, json_path, pljson_null(), base); + else + pljson_ext.put(objlist, json_path, elem, base); + end if; + self := objlist.get_values; + end path_put; + + member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem boolean, base number default 1) as + objlist pljson; + jp pljson_list := pljson_ext.parsePath(json_path, base); + begin + while (jp.head().get_number() > self.count) loop + self.append(pljson_null()); + end loop; + + objlist := pljson(self); + if (elem is null) then + pljson_ext.put(objlist, json_path, pljson_null(), base); + else + pljson_ext.put(objlist, json_path, elem, base); + end if; + self := objlist.get_values; + end path_put; + + member procedure path_put(self in out nocopy pljson_list, json_path varchar2, elem pljson_list, base number default 1) as + objlist pljson; + jp pljson_list := pljson_ext.parsePath(json_path, base); + begin + while (jp.head().get_number() > self.count) loop + self.append(pljson_null()); + end loop; + + objlist := pljson(self); + if (elem is null) then + pljson_ext.put(objlist, json_path, pljson_null(), base); + else + pljson_ext.put(objlist, json_path, elem, base); + end if; + self := objlist.get_values; + end path_put; + + /* json path_remove */ + member procedure path_remove(self in out nocopy pljson_list, json_path varchar2, base number default 1) as + objlist pljson := pljson(self); + begin + pljson_ext.remove(objlist, json_path, base); + self := objlist.get_values; + end path_remove; + + /* private method for internal use, not part of the API, contributed by @asfernandes */ + overriding member procedure get_internal_path(self in pljson_list, path pljson_path, path_position pls_integer, ret out nocopy pljson_element) as + indx pls_integer := path(path_position).indx; + begin + if (indx <= self.list_data.count) then + if (path_position < path.count) then + self.list_data(indx).get_internal_path(path, path_position + 1, ret); + else + ret := self.list_data(indx); + end if; + end if; + end; + + /* private method for internal use, not part of the API, contributed by @asfernandes */ + overriding member function put_internal_path(self in out nocopy pljson_list, path pljson_path, elem pljson_element, path_position pls_integer) return boolean as + indx pls_integer := path(path_position).indx; + begin + indx := path(path_position).indx; + if (indx > self.list_data.count) then + if (elem is null) then + return false; + end if; + + self.list_data.extend; + self.list_data(self.list_data.count) := pljson_null(); + + if (indx > self.list_data.count) then + self.list_data.extend(indx - self.list_data.count, self.list_data.count); + end if; + end if; + + if (path_position < path.count) then + if (path(path_position + 1).indx is null) then + if (not self.list_data(indx).is_object()) then + if (elem is not null) then + self.list_data(indx) := pljson(); + else + return false; + end if; + end if; + else + if (not self.list_data(indx).is_object() and not self.list_data(indx).is_array()) then + if (elem is not null) then + self.list_data(indx) := pljson_list(); + else + return false; + end if; + end if; + end if; + + if (self.list_data(indx).put_internal_path(path, elem, path_position + 1)) then + self.remove(indx); + return self.list_data.count = 0; + end if; + else + if (elem is not null) then + self.list_data(indx) := elem; + else + self.remove(indx); + return self.list_data.count = 0; + end if; + end if; + + return false; + end; +end; +/ +show err + +-- --- pljson.type.impl (body) --- +create or replace type body pljson as + + /* constructors */ + constructor function pljson return self as result as + begin + self.json_data := pljson_element_array(); + self.typeval := 1; + self.check_for_duplicate := 1; + + --self.object_id := pljson_object_cache.next_id; + return; + end; + + constructor function pljson(str varchar2) return self as result as + begin + self := pljson_parser.parser(str); + --self.typeval := 1; + self.check_for_duplicate := 1; + return; + end; + + constructor function pljson(str in clob) return self as result as + begin + self := pljson_parser.parser(str); + --self.typeval := 1; + self.check_for_duplicate := 1; + return; + end; + + constructor function pljson(str in blob, charset varchar2 default 'UTF8') return self as result as + c_str clob; + begin + pljson_ext.blob2clob(str, c_str, charset); + self := pljson_parser.parser(c_str); + --self.typeval := 1; + self.check_for_duplicate := 1; + return; + end; + + constructor function pljson(str_array pljson_varray) return self as result as + new_pair boolean := True; + pair_name varchar2(32767); + pair_value varchar2(32767); + begin + self.typeval := 1; + self.check_for_duplicate := 1; + self.json_data := pljson_element_array(); + for i in str_array.FIRST .. str_array.LAST loop + if new_pair then + pair_name := str_array(i); + new_pair := False; + else + pair_value := str_array(i); + put(pair_name, pair_value); + new_pair := True; + end if; + end loop; + + --self.object_id := pljson_object_cache.next_id; + return; + end; + + constructor function pljson(elem pljson_element) return self as result as + begin + self := treat(elem as pljson); + --self.typeval := 1; + self.check_for_duplicate := 1; + return; + end; + + constructor function pljson(l pljson_list) return self as result as + begin + self.typeval := 1; + self.check_for_duplicate := 1; + self.json_data := pljson_element_array(); + for i in 1 .. l.list_data.count loop + self.json_data.extend(1); + self.json_data(i) := l.list_data(i); + if (l.list_data(i).mapname is null or l.list_data(i).mapname like 'row%') then + self.json_data(i).mapname := 'row'||i; + end if; + self.json_data(i).mapindx := i; + end loop; + + --self.object_id := pljson_object_cache.next_id; + return; + end; + + overriding member function is_object return boolean as + begin + return true; + end; + + overriding member function value_of(max_byte_size number default null, max_char_size number default null) return varchar2 as + begin + return 'json object'; + end; + + /* member management */ + member procedure remove(self in out nocopy pljson, pair_name varchar2) as + temp pljson_element; + indx pls_integer; + begin + temp := get(pair_name); + if (temp is null) then return; end if; + + indx := json_data.next(temp.mapindx); + loop + exit when indx is null; + json_data(indx).mapindx := indx - 1; + json_data(indx-1) := json_data(indx); + indx := json_data.next(indx); + end loop; + json_data.trim(1); + end; + + member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value pljson_element, position pls_integer default null) as + insert_value pljson_element; + indx pls_integer; x number; + temp pljson_element; + begin + --dbms_output.put_line('name: ' || pair_name); + + --if (pair_name is null) then + -- raise_application_error(-20102, 'JSON put-method type error: name cannot be null'); + --end if; + insert_value := pair_value; + if insert_value is null then + insert_value := pljson_null(); + end if; + insert_value.mapname := pair_name; + if (self.check_for_duplicate = 1) then temp := get(pair_name); else temp := null; end if; + if (temp is not null) then + insert_value.mapindx := temp.mapindx; + json_data(temp.mapindx) := insert_value; + return; + elsif (position is null or position > self.count) then + --insert at the end of the list + --dbms_output.put_line('insert end'); + json_data.extend(1); + /* changed to common style of updating mapindx; fix bug in assignment order */ + insert_value.mapindx := json_data.count; + json_data(json_data.count) := insert_value; + --dbms_output.put_line('mapindx: ' || insert_value.mapindx); + --dbms_output.put_line('mapname: ' || insert_value.mapname); + elsif (position < 2) then + --insert at the start of the list + indx := json_data.last; + json_data.extend; + loop + exit when indx is null; + temp := json_data(indx); + temp.mapindx := indx+1; + json_data(temp.mapindx) := temp; + indx := json_data.prior(indx); + end loop; + /* changed to common style of updating mapindx; fix bug in assignment order */ + insert_value.mapindx := 1; + json_data(1) := insert_value; + else + --insert somewhere in the list + indx := json_data.last; + --dbms_output.put_line('indx: ' || indx); + json_data.extend; + loop + --dbms_output.put_line('indx: ' || indx); + temp := json_data(indx); + temp.mapindx := indx + 1; + json_data(temp.mapindx) := temp; + exit when indx = position; + indx := json_data.prior(indx); + end loop; + /* changed to common style of updating mapindx; fix bug in assignment order */ + insert_value.mapindx := position; + json_data(position) := insert_value; + end if; + end; + + member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value varchar2, position pls_integer default null) as + begin + if (pair_value is null and pljson_parser.empty_string_as_null) then + put(pair_name, pljson_null(), position); + else + put(pair_name, pljson_string(pair_value), position); + end if; + end; + + member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value clob, position pls_integer default null) as + begin + if (pair_value is null) then + put(pair_name, pljson_null(), position); + else + put(pair_name, pljson_string(pair_value), position); + end if; + end; + + member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value number, position pls_integer default null) as + begin + if (pair_value is null) then + put(pair_name, pljson_null(), position); + else + put(pair_name, pljson_number(pair_value), position); + end if; + end; + + /* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */ + member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value binary_double, position pls_integer default null) as + begin + if (pair_value is null) then + put(pair_name, pljson_null(), position); + else + put(pair_name, pljson_number(pair_value), position); + end if; + end; + + member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value boolean, position pls_integer default null) as + begin + if (pair_value is null) then + put(pair_name, pljson_null(), position); + else + put(pair_name, pljson_bool(pair_value), position); + end if; + end; + + member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value pljson, position pls_integer default null) as + begin + if (pair_value is null) then + put(pair_name, pljson_null(), position); + else + put(pair_name, treat(pair_value as pljson_element), position); + end if; + end; + + member procedure put(self in out nocopy pljson, pair_name varchar2, pair_value pljson_list, position pls_integer default null) as + begin + if (pair_value is null) then + put(pair_name, pljson_null(), position); + else + put(pair_name, treat(pair_value as pljson_element), position); + end if; + end; + + overriding member function count return number as + begin + return self.json_data.count; + end; + + overriding member function get(pair_name varchar2) return pljson_element as + indx pls_integer; + begin + indx := json_data.first; + loop + exit when indx is null; + if (pair_name is null and json_data(indx).mapname is null) then return json_data(indx); end if; + if (json_data(indx).mapname = pair_name) then return json_data(indx); end if; + indx := json_data.next(indx); + end loop; + return null; + end; + + member function get_string(pair_name varchar2) return varchar2 as + elem pljson_element := get(pair_name); + begin + if elem is not null and elem is of (pljson_string) then + return elem.get_string(); + end if; + return null; + end; + + member function get_clob(pair_name varchar2) return clob as + elem pljson_element := get(pair_name); + begin + if elem is not null and elem is of (pljson_string) then + return elem.get_clob(); + end if; + return null; + end; + + member function get_number(pair_name varchar2) return number as + elem pljson_element := get(pair_name); + begin + if elem is not null and elem is of (pljson_number) then + return elem.get_number(); + end if; + return null; + end; + + member function get_double(pair_name varchar2) return binary_double as + elem pljson_element := get(pair_name); + begin + if elem is not null and elem is of (pljson_number) then + return elem.get_double(); + end if; + return null; + end; + + member function get_bool(pair_name varchar2) return boolean as + elem pljson_element := get(pair_name); + begin + if elem is not null and elem is of (pljson_bool) then + return elem.get_bool(); + end if; + return null; + end; + + member function get_pljson(pair_name varchar2) return pljson as + elem pljson_element := get(pair_name); + begin + if elem is not null and elem is of (pljson) then + return treat(elem as pljson); + end if; + return null; + end; + + member function get_pljson_list(pair_name varchar2) return pljson_list as + elem pljson_element := get(pair_name); + begin + if elem is not null and elem is of (pljson_list) then + return treat(elem as pljson_list); + end if; + return null; + end; + + overriding member function get(position pls_integer) return pljson_element as + begin + if (self.count >= position and position > 0) then + return self.json_data(position); + end if; + return null; -- do not throw error, just return null + end; + + member function index_of(pair_name varchar2) return number as + indx pls_integer; + begin + indx := json_data.first; + loop + exit when indx is null; + if (pair_name is null and json_data(indx).mapname is null) then return indx; end if; + if (json_data(indx).mapname = pair_name) then return indx; end if; + indx := json_data.next(indx); + end loop; + return -1; + end; + + member function exist(pair_name varchar2) return boolean as + begin + return (get(pair_name) is not null); + end; + + member procedure check_duplicate(self in out nocopy pljson, v_set boolean) as + begin + if (v_set) then + check_for_duplicate := 1; + else + check_for_duplicate := 0; + end if; + end; + + member procedure remove_duplicates(self in out nocopy pljson) as + begin + pljson_parser.remove_duplicates(self); + end remove_duplicates; + + /* json path */ + overriding member function path(json_path varchar2, base number default 1) return pljson_element as + begin + return pljson_ext.get_json_element(self, json_path, base); + end path; + + /* json path_put */ + member procedure path_put(self in out nocopy pljson, json_path varchar2, elem pljson_element, base number default 1) as + begin + pljson_ext.put(self, json_path, elem, base); + end path_put; + + member procedure path_put(self in out nocopy pljson, json_path varchar2, elem varchar2, base number default 1) as + begin + if (elem is null and pljson_parser.empty_string_as_null) then + pljson_ext.put(self, json_path, pljson_null(), base); + else + pljson_ext.put(self, json_path, elem, base); + end if; + end path_put; + + member procedure path_put(self in out nocopy pljson, json_path varchar2, elem clob, base number default 1) as + begin + if (elem is null) then + pljson_ext.put(self, json_path, pljson_null(), base); + else + pljson_ext.put(self, json_path, elem, base); + end if; + end path_put; + + member procedure path_put(self in out nocopy pljson, json_path varchar2, elem number, base number default 1) as + begin + if (elem is null) then + pljson_ext.put(self, json_path, pljson_null(), base); + else + pljson_ext.put(self, json_path, elem, base); + end if; + end path_put; + + /* E.I.Sarmas (github.com/dsnz) 2016-12-01 support for binary_double numbers */ + member procedure path_put(self in out nocopy pljson, json_path varchar2, elem binary_double, base number default 1) as + begin + if (elem is null) then + pljson_ext.put(self, json_path, pljson_null(), base); + else + pljson_ext.put(self, json_path, elem, base); + end if; + end path_put; + + member procedure path_put(self in out nocopy pljson, json_path varchar2, elem boolean, base number default 1) as + begin + if (elem is null) then + pljson_ext.put(self, json_path, pljson_null(), base); + else + pljson_ext.put(self, json_path, elem, base); + end if; + end path_put; + + member procedure path_put(self in out nocopy pljson, json_path varchar2, elem pljson_list, base number default 1) as + begin + if (elem is null) then + pljson_ext.put(self, json_path, pljson_null(), base); + else + pljson_ext.put(self, json_path, elem, base); + end if; + end path_put; + + member procedure path_put(self in out nocopy pljson, json_path varchar2, elem pljson, base number default 1) as + begin + if (elem is null) then + pljson_ext.put(self, json_path, pljson_null(), base); + else + pljson_ext.put(self, json_path, elem, base); + end if; + end path_put; + + member procedure path_remove(self in out nocopy pljson, json_path varchar2, base number default 1) as + begin + pljson_ext.remove(self, json_path, base); + end path_remove; + + /* Thanks to Matt Nolan */ + member function get_keys return pljson_list as + keys pljson_list; + indx pls_integer; + begin + keys := pljson_list(); + indx := json_data.first; + loop + exit when indx is null; + keys.append(json_data(indx).mapname); + indx := json_data.next(indx); + end loop; + return keys; + end; + + member function get_values return pljson_list as + vals pljson_list := pljson_list(); + begin + vals.list_data := self.json_data; + return vals; + end; + + /* private method for internal use, not part of the API, contributed by @asfernandes */ + overriding member procedure get_internal_path(self in pljson, path pljson_path, path_position pls_integer, ret out nocopy pljson_element) as + indx pls_integer := path(path_position).indx; + begin + + if (indx is null) then + indx := self.json_data.first; + loop + exit when indx is null; + + if ((path(path_position).name is null and self.json_data(indx).mapname is null) or + (self.json_data(indx).mapname = path(path_position).name)) + then + if (path_position < path.count) then + self.json_data(indx).get_internal_path(path, path_position + 1, ret); + else + ret := self.json_data(indx); + end if; + + exit; + end if; + + indx := self.json_data.next(indx); + end loop; + else + if (indx <= self.json_data.count) then + if (path_position < path.count) then + self.json_data(indx).get_internal_path(path, path_position + 1, ret); + else + ret := self.json_data(indx); + end if; + end if; + end if; + end; + + /* private method for internal use, not part of the API, contributed by @asfernandes */ + overriding member function put_internal_path(self in out nocopy pljson, path pljson_path, elem pljson_element, path_position pls_integer) return boolean as + indx pls_integer; + keystring varchar2(4000); + new_obj pljson; + new_list pljson_list; + ret boolean := false; + begin + if (path(path_position).indx is null) then + keystring := path(path_position).name; + else + if (path(path_position).indx > self.json_data.count) then + if (elem is null) then + return false; + end if; + raise_application_error(-20110, 'PLJSON_EXT put error: access object with too few members.'); + end if; + + keystring := self.json_data(path(path_position).indx).mapname; + end if; + + indx := self.json_data.first; + loop + exit when indx is null; + + if ((keystring is null and self.json_data(indx).mapname is null) or (self.json_data(indx).mapname = keystring)) then + if (path_position < path.count) then + if (path(path_position + 1).indx is null) then + if (not self.json_data(indx).is_object()) then + if (elem is not null) then + put(keystring, pljson()); + else + return false; + end if; + end if; + else + if (not self.json_data(indx).is_object() and not self.json_data(indx).is_array()) then + if (elem is not null) then + put(keystring, pljson_list()); + else + return false; + end if; + end if; + end if; + + if (self.json_data(indx).put_internal_path(path, elem, path_position + 1)) then + self.remove(keystring); + return true; + end if; + else + if (elem is null) then + self.remove(keystring); + return true; + else + self.put(keystring, elem); + end if; + end if; + + return false; + end if; + + indx := self.json_data.next(indx); + end loop; + + if (elem is not null) then + if (path_position = path.count) then + put(keystring, elem); + else + if (path(path_position + 1).indx is null) then + new_obj := pljson(); + ret := new_obj.put_internal_path(path, elem, path_position + 1); + put(keystring, new_obj); + else + new_list := pljson_list(); + ret := new_list.put_internal_path(path, elem, path_position + 1); + put(keystring, new_list); + end if; + end if; + end if; + + return ret; + end; +end; +/ +show err + +-- ==================================================================== +-- STEP 5: GRANT EXECUTE la PUBLIC +-- ==================================================================== +PROMPT [5/6] Grant EXECUTE to PUBLIC...; + +GRANT EXECUTE ON pljson_path_segment TO PUBLIC; +GRANT EXECUTE ON pljson_path TO PUBLIC; +GRANT EXECUTE ON pljson_element TO PUBLIC; +GRANT EXECUTE ON pljson_element_array TO PUBLIC; +GRANT EXECUTE ON pljson_varray TO PUBLIC; +GRANT EXECUTE ON pljson_narray TO PUBLIC; +GRANT EXECUTE ON pljson_list TO PUBLIC; +GRANT EXECUTE ON pljson TO PUBLIC; +GRANT EXECUTE ON pljson_string TO PUBLIC; +GRANT EXECUTE ON pljson_number TO PUBLIC; +GRANT EXECUTE ON pljson_bool TO PUBLIC; +GRANT EXECUTE ON pljson_null TO PUBLIC; +GRANT EXECUTE ON pljson_parser TO PUBLIC; +GRANT EXECUTE ON pljson_printer TO PUBLIC; +GRANT EXECUTE ON pljson_ext TO PUBLIC; + +-- ==================================================================== +-- STEP 6: PUBLIC SYNONYMS +-- ==================================================================== +PROMPT [6/6] Creare PUBLIC SYNONYMS...; + +CREATE PUBLIC SYNONYM pljson_path_segment FOR CONTAFIN_ORACLE.pljson_path_segment; +CREATE PUBLIC SYNONYM pljson_path FOR CONTAFIN_ORACLE.pljson_path; +CREATE PUBLIC SYNONYM pljson_element FOR CONTAFIN_ORACLE.pljson_element; +CREATE PUBLIC SYNONYM pljson_element_array FOR CONTAFIN_ORACLE.pljson_element_array; +CREATE PUBLIC SYNONYM pljson_varray FOR CONTAFIN_ORACLE.pljson_varray; +CREATE PUBLIC SYNONYM pljson_narray FOR CONTAFIN_ORACLE.pljson_narray; +CREATE PUBLIC SYNONYM pljson_list FOR CONTAFIN_ORACLE.pljson_list; +CREATE PUBLIC SYNONYM pljson FOR CONTAFIN_ORACLE.pljson; +CREATE PUBLIC SYNONYM pljson_string FOR CONTAFIN_ORACLE.pljson_string; +CREATE PUBLIC SYNONYM pljson_number FOR CONTAFIN_ORACLE.pljson_number; +CREATE PUBLIC SYNONYM pljson_bool FOR CONTAFIN_ORACLE.pljson_bool; +CREATE PUBLIC SYNONYM pljson_null FOR CONTAFIN_ORACLE.pljson_null; +CREATE PUBLIC SYNONYM pljson_parser FOR CONTAFIN_ORACLE.pljson_parser; +CREATE PUBLIC SYNONYM pljson_printer FOR CONTAFIN_ORACLE.pljson_printer; +CREATE PUBLIC SYNONYM pljson_ext FOR CONTAFIN_ORACLE.pljson_ext; + +-- ==================================================================== +-- Verificare +-- ==================================================================== +PROMPT; +PROMPT Verificare obiecte create:; +SELECT object_name, object_type, status + FROM user_objects + WHERE object_name LIKE 'PLJSON%' + ORDER BY object_type, object_name; + +PROMPT; +PROMPT Test rapid:; +DECLARE + v_arr pljson_list; + v_obj pljson; + v_sku VARCHAR2(100); +BEGIN + v_arr := pljson_list('[{"sku":"TEST1","price":"10.5"},{"sku":"TEST2","price":"25.0"}]'); + FOR i IN 1 .. v_arr.count LOOP + v_obj := pljson(v_arr.get(i)); + v_sku := v_obj.get_string('sku'); + DBMS_OUTPUT.PUT_LINE(' Articol ' || i || ': SKU=' || v_sku || ', pret=' || v_obj.get_string('price')); + END LOOP; + DBMS_OUTPUT.PUT_LINE('PL/JSON instalat cu succes!'); +END; +/ + +exec contafin_oracle.pack_migrare.UpdateVersiune('co_2026_03_10_02_COMUN_PLJSON'); +commit; + +PROMPT; +PROMPT =============================================; +PROMPT Instalare PL/JSON completa!; +PROMPT =============================================; +PROMPT; diff --git a/scripts/parse_sync_log.py b/scripts/parse_sync_log.py new file mode 100644 index 0000000..a68943f --- /dev/null +++ b/scripts/parse_sync_log.py @@ -0,0 +1,306 @@ +#!/usr/bin/env python3 +""" +Parser pentru log-urile sync_comenzi_web. +Extrage comenzi esuate, SKU-uri lipsa, si genereaza un sumar. +Suporta atat formatul vechi (verbose) cat si formatul nou (compact). + +Utilizare: + python parse_sync_log.py # Ultimul log din vfp/log/ + python parse_sync_log.py # Log specific + python parse_sync_log.py --skus # Doar lista SKU-uri lipsa + python parse_sync_log.py --dir /path/to/logs # Director custom +""" + +import os +import sys +import re +import glob +import argparse + +# Regex pentru linii cu timestamp (intrare noua in log) +RE_TIMESTAMP = re.compile(r'^\[(\d{2}:\d{2}:\d{2})\]\s+\[(\w+\s*)\]\s*(.*)') + +# Regex format NOU: [N/Total] OrderNumber P:X A:Y/Z -> OK/ERR details +RE_COMPACT_OK = re.compile(r'\[(\d+)/(\d+)\]\s+(\S+)\s+.*->\s+OK\s+ID:(\S+)') +RE_COMPACT_ERR = re.compile(r'\[(\d+)/(\d+)\]\s+(\S+)\s+.*->\s+ERR\s+(.*)') + +# Regex format VECHI (backwards compat) +RE_SKU_NOT_FOUND = re.compile(r'SKU negasit.*?:\s*(\S+)') +RE_PRICE_POLICY = re.compile(r'Pretul pentru acest articol nu a fost gasit') +RE_FAILED_ORDER = re.compile(r'Import comanda esuat pentru\s+(\S+)') +RE_ARTICOL_ERR = re.compile(r'Eroare adaugare articol\s+(\S+)') +RE_ORDER_PROCESS = re.compile(r'Procesez comanda:\s+(\S+)\s+din\s+(\S+)') +RE_ORDER_SUCCESS = re.compile(r'SUCCES: Comanda importata.*?ID Oracle:\s+(\S+)') + +# Regex comune +RE_SYNC_END = re.compile(r'SYNC END\s*\|.*?(\d+)\s+processed.*?(\d+)\s+ok.*?(\d+)\s+err') +RE_STATS_LINE = re.compile(r'Duration:\s*(\S+)\s*\|\s*Orders:\s*(\S+)') +RE_STOPPED_EARLY = re.compile(r'Peste \d+.*ero|stopped early') + + +def find_latest_log(log_dir): + """Gaseste cel mai recent log sync_comenzi din directorul specificat.""" + pattern = os.path.join(log_dir, 'sync_comenzi_*.log') + files = glob.glob(pattern) + if not files: + return None + return max(files, key=os.path.getmtime) + + +def parse_log_entries(lines): + """Parseaza liniile log-ului in intrari structurate.""" + entries = [] + current = None + + for line in lines: + line = line.rstrip('\n\r') + m = RE_TIMESTAMP.match(line) + if m: + if current: + entries.append(current) + current = { + 'time': m.group(1), + 'level': m.group(2).strip(), + 'text': m.group(3), + 'full': line, + 'continuation': [] + } + elif current is not None: + current['continuation'].append(line) + current['text'] += '\n' + line + + if current: + entries.append(current) + + return entries + + +def extract_sku_from_error(err_text): + """Extrage SKU din textul erorii (diverse formate).""" + # SKU_NOT_FOUND: 8714858424056 + m = re.search(r'SKU_NOT_FOUND:\s*(\S+)', err_text) + if m: + return ('SKU_NOT_FOUND', m.group(1)) + + # PRICE_POLICY: 8000070028685 + m = re.search(r'PRICE_POLICY:\s*(\S+)', err_text) + if m: + return ('PRICE_POLICY', m.group(1)) + + # Format vechi: SKU negasit...NOM_ARTICOLE: xxx + m = RE_SKU_NOT_FOUND.search(err_text) + if m: + return ('SKU_NOT_FOUND', m.group(1)) + + # Format vechi: Eroare adaugare articol xxx + m = RE_ARTICOL_ERR.search(err_text) + if m: + return ('ARTICOL_ERROR', m.group(1)) + + # Format vechi: Pretul... + if RE_PRICE_POLICY.search(err_text): + return ('PRICE_POLICY', '(SKU necunoscut)') + + return (None, None) + + +def analyze_entries(entries): + """Analizeaza intrarile si extrage informatii relevante.""" + result = { + 'start_time': None, + 'end_time': None, + 'duration': None, + 'total_orders': 0, + 'success_orders': 0, + 'error_orders': 0, + 'stopped_early': False, + 'failed': [], + 'missing_skus': [], + } + + seen_skus = set() + current_order = None + + for entry in entries: + text = entry['text'] + level = entry['level'] + + # Start/end time + if entry['time']: + if result['start_time'] is None: + result['start_time'] = entry['time'] + result['end_time'] = entry['time'] + + # Format NOU: SYNC END line cu statistici + m = RE_SYNC_END.search(text) + if m: + result['total_orders'] = int(m.group(1)) + result['success_orders'] = int(m.group(2)) + result['error_orders'] = int(m.group(3)) + + # Format NOU: compact OK line + m = RE_COMPACT_OK.search(text) + if m: + continue + + # Format NOU: compact ERR line + m = RE_COMPACT_ERR.search(text) + if m: + order_nr = m.group(3) + err_detail = m.group(4).strip() + err_type, sku = extract_sku_from_error(err_detail) + if err_type and sku: + result['failed'].append((order_nr, err_type, sku)) + if sku not in seen_skus and sku != '(SKU necunoscut)': + seen_skus.add(sku) + result['missing_skus'].append(sku) + else: + result['failed'].append((order_nr, 'ERROR', err_detail[:60])) + continue + + # Stopped early + if RE_STOPPED_EARLY.search(text): + result['stopped_early'] = True + + # Format VECHI: statistici din sumar + if 'Total comenzi procesate:' in text: + try: + result['total_orders'] = int(text.split(':')[-1].strip()) + except ValueError: + pass + if 'Comenzi importate cu succes:' in text: + try: + result['success_orders'] = int(text.split(':')[-1].strip()) + except ValueError: + pass + if 'Comenzi cu erori:' in text: + try: + result['error_orders'] = int(text.split(':')[-1].strip()) + except ValueError: + pass + + # Format VECHI: Duration line + m = RE_STATS_LINE.search(text) + if m: + result['duration'] = m.group(1) + + # Format VECHI: erori + if level == 'ERROR': + m_fail = RE_FAILED_ORDER.search(text) + if m_fail: + current_order = m_fail.group(1) + + m = RE_ORDER_PROCESS.search(text) + if m: + current_order = m.group(1) + + err_type, sku = extract_sku_from_error(text) + if err_type and sku: + order_nr = current_order or '?' + result['failed'].append((order_nr, err_type, sku)) + if sku not in seen_skus and sku != '(SKU necunoscut)': + seen_skus.add(sku) + result['missing_skus'].append(sku) + + # Duration din SYNC END + m = re.search(r'\|\s*(\d+)s\s*$', text) + if m: + result['duration'] = m.group(1) + 's' + + return result + + +def format_report(result, log_path): + """Formateaza raportul complet.""" + lines = [] + lines.append('=== SYNC LOG REPORT ===') + lines.append(f'File: {os.path.basename(log_path)}') + + duration = result["duration"] or "?" + start = result["start_time"] or "?" + end = result["end_time"] or "?" + lines.append(f'Run: {start} - {end} ({duration})') + lines.append('') + + stopped = 'YES' if result['stopped_early'] else 'NO' + lines.append( + f'SUMMARY: {result["total_orders"]} processed, ' + f'{result["success_orders"]} success, ' + f'{result["error_orders"]} errors ' + f'(stopped early: {stopped})' + ) + lines.append('') + + if result['failed']: + lines.append('FAILED ORDERS:') + seen = set() + for order_nr, err_type, sku in result['failed']: + key = (order_nr, err_type, sku) + if key not in seen: + seen.add(key) + lines.append(f' {order_nr:<12} {err_type:<18} {sku}') + lines.append('') + + if result['missing_skus']: + lines.append(f'MISSING SKUs ({len(result["missing_skus"])} unique):') + for sku in sorted(result['missing_skus']): + lines.append(f' {sku}') + lines.append('') + + return '\n'.join(lines) + + +def main(): + parser = argparse.ArgumentParser( + description='Parser pentru log-urile sync_comenzi_web' + ) + parser.add_argument( + 'logfile', nargs='?', default=None, + help='Fisier log specific (default: ultimul din vfp/log/)' + ) + parser.add_argument( + '--skus', action='store_true', + help='Afiseaza doar lista SKU-uri lipsa (una pe linie)' + ) + parser.add_argument( + '--dir', default=None, + help='Director cu log-uri (default: vfp/log/ relativ la script)' + ) + + args = parser.parse_args() + + if args.logfile: + log_path = args.logfile + else: + if args.dir: + log_dir = args.dir + else: + script_dir = os.path.dirname(os.path.abspath(__file__)) + project_dir = os.path.dirname(script_dir) + log_dir = os.path.join(project_dir, 'vfp', 'log') + + log_path = find_latest_log(log_dir) + if not log_path: + print(f'Nu am gasit fisiere sync_comenzi_*.log in {log_dir}', + file=sys.stderr) + sys.exit(1) + + if not os.path.isfile(log_path): + print(f'Fisierul nu exista: {log_path}', file=sys.stderr) + sys.exit(1) + + with open(log_path, 'r', encoding='utf-8', errors='replace') as f: + lines = f.readlines() + + entries = parse_log_entries(lines) + result = analyze_entries(entries) + + if args.skus: + for sku in sorted(result['missing_skus']): + print(sku) + else: + print(format_report(result, log_path)) + + +if __name__ == '__main__': + main() diff --git a/vfp/sync-comenzi-web.prg b/vfp/sync-comenzi-web.prg index cf5c6a2..1e925f4 100644 --- a/vfp/sync-comenzi-web.prg +++ b/vfp/sync-comenzi-web.prg @@ -11,13 +11,14 @@ Set Ansi On Set Deleted On *-- Variabile globale -Private gcAppPath, gcLogFile, gnStartTime, gnOrdersProcessed, gnOrdersSuccess, gnOrdersErrors -Private goConnectie, goSettings, goAppSetup +Private gcAppPath, gcLogFile, gnStartTime, gnOrdersProcessed, gnOrdersSuccess, gnOrdersErrors, gcFailedSKUs +Private goConnectie, goSettings, goAppSetup, gcStepError Local lcJsonPattern, laJsonFiles[1], lnJsonFiles, lnIndex, lcJsonFile Local loJsonData, lcJsonContent, lnOrderCount, lnOrderIndex Local loOrder, lcResult, llProcessSuccess, lcPath goConnectie = Null +gcStepError = "" *-- Initializare gcAppPath = Addbs(Justpath(Sys(16,0))) @@ -37,100 +38,72 @@ gnStartTime = Seconds() gnOrdersProcessed = 0 gnOrdersSuccess = 0 gnOrdersErrors = 0 +gcFailedSKUs = "" *-- Initializare logging gcLogFile = InitLog("sync_comenzi") -LogMessage("=== SYNC COMENZI WEB > ORACLE ROA ===", "INFO", gcLogFile) *-- Creare si initializare clasa setup aplicatie goAppSetup = Createobject("ApplicationSetup", gcAppPath) -*-- Setup complet cu validare si afisare configuratie If !goAppSetup.Initialize() LogMessage("EROARE: Setup-ul aplicatiei a esuat sau necesita configurare!", "ERROR", gcLogFile) Return .F. Endif -*-- Obtinere setari din clasa goSettings = goAppSetup.GetSettings() *-- Verificare directoare necesare If !Directory(gcAppPath + "output") - LogMessage("EROARE: Directorul output/ nu exista! Ruleaza mai intai adapter-ul web", "ERROR", gcLogFile) + LogMessage("EROARE: Directorul output/ nu exista!", "ERROR", gcLogFile) Return .F. Endif -*-- Rulare automata adapter pentru obtinere comenzi (daca este configurat) +*-- Rulare automata adapter pentru obtinere comenzi If goSettings.AutoRunAdapter - LogMessage("Rulez adapter pentru obtinere comenzi: " + goSettings.AdapterProgram, "INFO", gcLogFile) If !ExecuteAdapter() - LogMessage("EROARE la rularea adapter-ului, continuez cu fisierele JSON existente", "WARN", gcLogFile) + LogMessage("EROARE adapter, continuez cu JSON existente", "WARN", gcLogFile) Endif -Else - LogMessage("AutoRunAdapter este dezactivat, folosesc doar fisierele JSON existente", "INFO", gcLogFile) Endif -*-- Gasire fisiere JSON comenzi din pattern configurat +*-- Gasire fisiere JSON comenzi lcJsonPattern = gcAppPath + "output\" + goSettings.JsonFilePattern lnJsonFiles = Adir(laJsonFiles, lcJsonPattern) If lnJsonFiles = 0 - LogMessage("AVERTISMENT: Nu au fost gasite fisiere JSON cu comenzi web", "WARN", gcLogFile) - LogMessage("Ruleaza mai intai adapter-ul web cu GetOrders=1 in settings.ini", "INFO", gcLogFile) + LogMessage("Nu au fost gasite fisiere JSON cu comenzi web", "WARN", gcLogFile) Return .T. Endif -LogMessage("Gasite " + Transform(lnJsonFiles) + " fisiere JSON cu comenzi web", "INFO", gcLogFile) - -*-- Incercare conectare Oracle (folosind conexiunea existenta din sistem) +*-- Conectare Oracle If !ConnectToOracle() LogMessage("EROARE: Nu s-a putut conecta la Oracle ROA", "ERROR", gcLogFile) Return .F. Endif -SET STEP ON + +*-- Header compact +LogMessage("SYNC START | " + goSettings.OracleDSN + " " + goSettings.OracleUser + " | " + Transform(lnJsonFiles) + " JSON files", "INFO", gcLogFile) + *-- Procesare fiecare fisier JSON gasit For lnIndex = 1 To lnJsonFiles lcJsonFile = gcAppPath + "output\" + laJsonFiles[lnIndex, 1] - LogMessage("Procesez fisierul: " + laJsonFiles[lnIndex, 1], "INFO", gcLogFile) - *-- Citire si parsare JSON Try lcJsonContent = Filetostr(lcJsonFile) If Empty(lcJsonContent) - LogMessage("AVERTISMENT: Fisier JSON gol - " + laJsonFiles[lnIndex, 1], "WARN", gcLogFile) Loop Endif - *-- Parsare JSON array cu comenzi loJsonData = nfjsonread(lcJsonContent) - If Isnull(loJsonData) - LogMessage("EROARE: Nu s-a putut parsa JSON-ul din " + laJsonFiles[lnIndex, 1], "ERROR", gcLogFile) + If Isnull(loJsonData) Or Type('loJsonData') != 'O' Or Type('loJsonData.orders') != 'O' + LogMessage("EROARE JSON: " + laJsonFiles[lnIndex, 1], "ERROR", gcLogFile) Loop Endif - *-- Verificare daca este obiect JSON valid - If Type('loJsonData') != 'O' - LogMessage("EROARE: JSON-ul nu este un obiect valid - " + laJsonFiles[lnIndex, 1], "ERROR", gcLogFile) - Loop - Endif - - *-- Verificare structura GoMag (cu proprietatea "orders") - If Type('loJsonData.orders') != 'O' - LogMessage("EROARE: JSON-ul nu contine proprietatea 'orders' - " + laJsonFiles[lnIndex, 1], "ERROR", gcLogFile) - Loop - Endif - - *-- Obtinere numar comenzi din obiectul orders Local Array laOrderProps[1] lnOrderCount = Amembers(laOrderProps, loJsonData.orders, 0) - LogMessage("Gasite " + Transform(lnOrderCount) + " comenzi in " + laJsonFiles[lnIndex, 1], "INFO", gcLogFile) - *-- Log informatii pagina daca sunt disponibile - If Type('loJsonData.page') = 'C' Or Type('loJsonData.page') = 'N' - LogMessage("Pagina: " + Transform(loJsonData.Page) + " din " + Transform(loJsonData.Pages), "DEBUG", gcLogFile) - Endif - - *-- Procesare fiecare comanda din obiectul orders + *-- Procesare fiecare comanda For lnOrderIndex = 1 To lnOrderCount Local lcOrderId, loOrder lcOrderId = laOrderProps[lnOrderIndex] @@ -138,35 +111,28 @@ For lnIndex = 1 To lnJsonFiles If Type('loOrder') = 'O' gnOrdersProcessed = gnOrdersProcessed + 1 - LogMessage("Procesez comanda ID: " + lcOrderId + " (Nr: " + Iif(Type('loOrder.number') = 'C', loOrder.Number, "NECUNOSCUT") + ")", "DEBUG", gcLogFile) - llProcessSuccess = ProcessWebOrder(loOrder) + llProcessSuccess = ProcessWebOrder(loOrder, lnOrderIndex, lnOrderCount) If llProcessSuccess gnOrdersSuccess = gnOrdersSuccess + 1 Else gnOrdersErrors = gnOrdersErrors + 1 Endif - Else - LogMessage("AVERTISMENT: Comanda cu ID " + lcOrderId + " nu este un obiect valid", "WARN", gcLogFile) Endif - * Daca sunt peste 10 erori, ies din import fara sa mai import alte comenzi - * Probabil ca sunt erori in cod / baza de date If m.gnOrdersErrors > 10 Exit Endif Endfor Catch To loError - LogMessage("EROARE la procesarea fisierului " + laJsonFiles[lnIndex, 1] + ": " + loError.Message, "ERROR", gcLogFile) + LogMessage("EROARE fisier " + laJsonFiles[lnIndex, 1] + ": " + loError.Message, "ERROR", gcLogFile) gnOrdersErrors = gnOrdersErrors + 1 Endtry - * Daca sunt peste 10 erori, ies din import fara sa mai import alte comenzi - * Probabil ca sunt erori in cod / baza de date If m.gnOrdersErrors > 10 - LogMessage("Peste 10 comenzi au dat eroare la import. Nu se mai importa restul de comenzi.", "ERROR", gcLogFile) + LogMessage("Peste 10 erori, stop import", "ERROR", gcLogFile) Exit Endif Endfor @@ -174,11 +140,26 @@ Endfor *-- Inchidere conexiune Oracle DisconnectFromOracle() -*-- Logging final cu statistici -LogMessage("=== PROCESARE COMPLETA ===", "INFO", gcLogFile) -LogMessage("Total comenzi procesate: " + Transform(gnOrdersProcessed), "INFO", gcLogFile) -LogMessage("Comenzi importate cu succes: " + Transform(gnOrdersSuccess), "INFO", gcLogFile) -LogMessage("Comenzi cu erori: " + Transform(gnOrdersErrors), "INFO", gcLogFile) +*-- Sumar SKU-uri lipsa +If !Empty(gcFailedSKUs) + LogMessage("=== SKU-URI LIPSA ===", "INFO", gcLogFile) + Local lnSkuCount, lnSkuIdx + Local Array laSkus[1] + lnSkuCount = Alines(laSkus, gcFailedSKUs, .T., CHR(10)) + For lnSkuIdx = 1 To lnSkuCount + If !Empty(laSkus[lnSkuIdx]) + LogMessage(Alltrim(laSkus[lnSkuIdx]), "INFO", gcLogFile) + Endif + Endfor + LogMessage("=== SFARSIT SKU-URI LIPSA ===", "INFO", gcLogFile) +Endif + +*-- Footer compact +Local lcStopped, lnSkuTotal, lnDuration +lnDuration = Int(Seconds() - gnStartTime) +lnSkuTotal = Iif(Empty(gcFailedSKUs), 0, Occurs(CHR(10), gcFailedSKUs) + 1) +lcStopped = Iif(gnOrdersErrors > 10, " (stopped early)", "") +LogMessage("SYNC END | " + Transform(gnOrdersProcessed) + " processed: " + Transform(gnOrdersSuccess) + " ok, " + Transform(gnOrdersErrors) + " err" + lcStopped + " | " + Transform(lnSkuTotal) + " SKUs lipsa | " + Transform(lnDuration) + "s", "INFO", gcLogFile) CloseLog(gnStartTime, 0, gnOrdersProcessed, gcLogFile) Return .T. @@ -187,132 +168,123 @@ Return .T. *-- HELPER FUNCTIONS *-- =================================================================== -*-- Functie pentru conectarea la Oracle folosind setarile din settings.ini +*-- Conectare la Oracle Function ConnectToOracle - Local llSuccess, lcConnectionString, lnHandle + Local llSuccess, lnHandle llSuccess = .F. Try - *-- Conectare Oracle folosind datele din settings.ini lnHandle = SQLConnect(goSettings.OracleDSN, goSettings.OracleUser, goSettings.OraclePassword) If lnHandle > 0 goConnectie = lnHandle llSuccess = .T. - LogMessage("Conectare Oracle reusita - Handle: " + Transform(lnHandle), "INFO", gcLogFile) - LogMessage("DSN: " + goSettings.OracleDSN + " | User: " + goSettings.OracleUser, "DEBUG", gcLogFile) Else - LogMessage("EROARE: Conectare Oracle esuata - Handle: " + Transform(lnHandle), "ERROR", gcLogFile) - LogMessage("DSN: " + goSettings.OracleDSN + " | User: " + goSettings.OracleUser, "ERROR", gcLogFile) + LogMessage("EROARE conectare Oracle: Handle=" + Transform(lnHandle), "ERROR", gcLogFile) Endif Catch To loError - LogMessage("EROARE la conectarea Oracle: " + loError.Message, "ERROR", gcLogFile) + LogMessage("EROARE conectare Oracle: " + loError.Message, "ERROR", gcLogFile) Endtry Return llSuccess Endfunc -*-- Functie pentru deconectarea de la Oracle +*-- Deconectare de la Oracle Function DisconnectFromOracle If Type('goConnectie') = 'N' And goConnectie > 0 SQLDisconnect(goConnectie) - LogMessage("Deconectare Oracle reusita", "INFO", gcLogFile) Endif Return .T. Endfunc -*-- Functie principala de procesare comanda web +*-- Procesare comanda web - logeaza O SINGURA LINIE per comanda +*-- Format: [N/Total] OrderNumber P:PartnerID A:AddrFact/AddrLivr -> OK/ERR details Function ProcessWebOrder - Parameters loOrder + Lparameters loOrder, tnIndex, tnTotal Local llSuccess, lcOrderNumber, lcOrderDate, lnPartnerID, lcArticlesJSON - Local lcObservatii, lcSQL, lnResult, lcErrorDetails, lnIdComanda, llSucces + Local lcSQL, lnResult, lcErrorDetails, lnIdComanda, llSucces Local ldOrderDate, loError - Local lnIdAdresaFacturare, lnIdAdresaLivrare, lcErrorMessage + Local lnIdAdresaFacturare, lnIdAdresaLivrare + Local lcPrefix, lcSummary, lcErrDetail lnIdAdresaLivrare = NULL lnIdAdresaFacturare = NULL - lnIdComanda = 0 + lnIdComanda = 0 llSucces = .T. + lnPartnerID = 0 + lcOrderNumber = "?" + + *-- Prefix: [N/Total] OrderNumber + lcPrefix = "[" + Transform(tnIndex) + "/" + Transform(tnTotal) + "]" Try *-- Validare comanda If !ValidateWebOrder(loOrder) - LogMessage("EROARE: Comanda web invalida - lipsesc date obligatorii", "ERROR", gcLogFile) - llSucces = .F. + LogMessage(lcPrefix + " ? -> ERR VALIDARE: date obligatorii lipsa", "ERROR", gcLogFile) + Return .F. Endif *-- Extragere date comanda - If m.llSucces - lcOrderNumber = CleanWebText(Transform(loOrder.Number)) - lcOrderDate = ConvertWebDate(loOrder.Date) && yyyymmdd - ldOrderDate = String2Date(m.lcOrderDate, 'yyyymmdd') + lcOrderNumber = CleanWebText(Transform(loOrder.Number)) + lcOrderDate = ConvertWebDate(loOrder.Date) + ldOrderDate = String2Date(m.lcOrderDate, 'yyyymmdd') + lcPrefix = lcPrefix + " " + lcOrderNumber - LogMessage("Procesez comanda: " + lcOrderNumber + " din " + lcOrderDate, "INFO", gcLogFile) + *-- Procesare partener + gcStepError = "" + lnPartnerID = ProcessPartner(loOrder.billing) + If lnPartnerID <= 0 + LogMessage(lcPrefix + " -> ERR PARTENER: " + Iif(Empty(gcStepError), "nu s-a putut procesa", gcStepError), "ERROR", gcLogFile) + Return .F. + Endif - *-- Procesare partener (billing address) - lnPartnerID = ProcessPartner(loOrder.billing) - If lnPartnerID <= 0 - LogMessage("EROARE: Nu s-a putut procesa partenerul pentru comanda " + lcOrderNumber, "ERROR", gcLogFile) - llSucces = .F. - Else - LogMessage("Partener identificat/creat: ID=" + Transform(lnPartnerID), "INFO", gcLogFile) - - *-- Adresa facturare - lnIdAdresaFacturare = ProcessAddress(m.lnPartnerID, loOrder.billing) - - IF TYPE('loOrder.shipping') = 'O' - *-- Adresa livrares - lnIdAdresaLivrare = ProcessAddress(m.lnPartnerID, loOrder.shipping) - ENDIF - Endif + *-- Adrese + lnIdAdresaFacturare = ProcessAddress(m.lnPartnerID, loOrder.billing) + If Type('loOrder.shipping') = 'O' + lnIdAdresaLivrare = ProcessAddress(m.lnPartnerID, loOrder.shipping) Endif *-- Construire JSON articole - If m.llSucces - lcArticlesJSON = BuildArticlesJSON(loOrder.items) - If Empty(m.lcArticlesJSON) - LogMessage("EROARE: Nu s-au gasit articole valide in comanda " + lcOrderNumber, "ERROR", gcLogFile) - llSucces = .F. - Endif + lcArticlesJSON = BuildArticlesJSON(loOrder.items) + If Empty(m.lcArticlesJSON) + LogMessage(lcPrefix + " P:" + Transform(lnPartnerID) + " -> ERR JSON_ARTICOLE", "ERROR", gcLogFile) + Return .F. Endif - *-- Construire observatii cu detalii suplimentare - *!* lcObservatii = BuildOrderObservations(loOrder) + *-- Import comanda in Oracle + lcSQL = "BEGIN PACK_IMPORT_COMENZI.importa_comanda(?lcOrderNumber, ?ldOrderDate, ?lnPartnerID, ?lcArticlesJSON, ?lnIdAdresaLivrare, ?lnIdAdresaFacturare, ?goSettings.IdPol, ?goSettings.IdSectie, ?@lnIdComanda); END;" + lnResult = SQLExec(goConnectie, lcSQL) - *-- Apel package Oracle pentru import comanda - If m.llSucces - lcSQL = "BEGIN PACK_IMPORT_COMENZI.importa_comanda(?lcOrderNumber, ?ldOrderDate, ?lnPartnerID, ?lcArticlesJSON, ?lnIdAdresaLivrare, ?lnIdAdresaFacturare, ?goSettings.IdPol, ?goSettings.IdSectie, ?@lnIdComanda); END;" - lnResult = SQLExec(goConnectie, lcSQL) + *-- Construire linie sumar cu ID-uri adrese + lcSummary = lcPrefix + " P:" + Transform(lnPartnerID) + ; + " A:" + Transform(Nvl(lnIdAdresaFacturare, 0)) + "/" + Transform(Nvl(lnIdAdresaLivrare, 0)) - If lnResult > 0 And Nvl(m.lnIdComanda,0) > 0 - LogMessage("SUCCES: Comanda importata - ID Oracle: " + Transform(m.lnIdComanda), "INFO", gcLogFile) - llSuccess = .T. - Else - llSuccess = .F. - *-- Obtinere detalii eroare Oracle - lcErrorDetails = GetOracleErrorDetails(m.lcSQL) - LogMessage("EROARE: Import comanda esuat pentru " + lcOrderNumber + CHR(10) + lcErrorDetails, "ERROR", gcLogFile) - Endif + If lnResult > 0 And Nvl(m.lnIdComanda, 0) > 0 + LogMessage(lcSummary + " -> OK ID:" + Transform(m.lnIdComanda), "INFO", gcLogFile) + Return .T. + Else + lcErrorDetails = GetOracleErrorDetails() + lcErrDetail = ClassifyImportError(lcErrorDetails) + CollectFailedSKUs(lcErrorDetails) + LogMessage(lcSummary + " -> ERR " + lcErrDetail, "ERROR", gcLogFile) + Return .F. Endif Catch To loError - llSucces = .F. - LogMessage("EXCEPTIE la procesarea comenzii " + lcOrderNumber + ": " + loError.Message, "ERROR", gcLogFile) + LogMessage(lcPrefix + " -> ERR EXCEPTIE: " + loError.Message, "ERROR", gcLogFile) + Return .F. Endtry - - Return llSuccess Endfunc -*-- Functie pentru validarea comenzii web +*-- Validare comanda web Function ValidateWebOrder Parameters loOrder Local llValid llValid = .T. - *-- Verificari obligatorii If Type('loOrder.number') != 'C' Or Empty(loOrder.Number) llValid = .F. Endif @@ -332,7 +304,7 @@ Function ValidateWebOrder Return llValid Endfunc -*-- Functie pentru procesarea partenerului din billing.company GoMag +*-- Procesare partener (fara logging, seteaza gcStepError la eroare) Function ProcessPartner Lparameters toBilling Local lcDenumire, lcCodFiscal, lcRegistru, lcAdresa, lcTelefon, lcEmail, lcRegistru @@ -344,147 +316,63 @@ Function ProcessPartner lcCodFiscal = '' lcRegistru = '' lnIsPersoanaJuridica = 0 - lcCodFiscal = Null && Persoanele fizice nu au CUI in platformele web - - If .F. - TEXT TO lcExampleJsonAdresa NOSHOW - "billing": { - "address": "STR. CAMPUL LINISTII, NR. 1", - "city": "Arad", - "company": { - "bank": "", - "code": "RO30071208", - "iban": "", - "name": "BASSANO BUILDINGS SRL", - "registrationNo": "" - }, - "country": "Romania", - "customerId": "13422", - "email": "office@bassano.ro", - "firstname": "Ionela", - "lastname": "Letcan", - "phone": "0728141899", - "region": "Arad" - }, - ENDTEXT - ENDIF + lcCodFiscal = Null Try - *-- Extragere date partener din datele billing If Type('toBilling.company') = 'O' And !Empty(toBilling.company.Name) loCompany = toBilling.company - *-- Companie - persoana juridica lcDenumire = CleanWebText(loCompany.Name) lcCodFiscal = Iif(Type('loCompany.code') = 'C', loCompany.Code, Null) lcCodFiscal = CleanWebText(m.lcCodFiscal) lcRegistru = Iif(Type('loCompany.registrationNo') = 'C', loCompany.registrationNo, Null) lcRegistru = CleanWebText(m.lcRegistru) - lnIsPersoanaJuridica = 1 && Persoana juridica + lnIsPersoanaJuridica = 1 Else - *-- Persoana fizica - IF TYPE('toBilling.firstname') = 'C' + If Type('toBilling.firstname') = 'C' lcDenumire = CleanWebText(Alltrim(toBilling.firstname) + " " + Alltrim(toBilling.lastname)) - lnIsPersoanaJuridica = 0 && Persoana fizica - ENDIF + lnIsPersoanaJuridica = 0 + Endif Endif - LogMessage("Partener: " + lcDenumire + " | CUI: " + Iif(Isnull(lcCodFiscal), "NULL", lcCodFiscal) + " | Tip: " + Iif(lnIsPersoanaJuridica = 1, "JURIDICA", "FIZICA"), "DEBUG", gcLogFile) - - * Cautare/creare client lcSQL = "BEGIN PACK_IMPORT_PARTENERI.cauta_sau_creeaza_partener(?lcCodFiscal, ?lcDenumire, ?lcRegistru, ?lnIsPersoanaJuridica, ?@lnIdPart); END;" - lnResult = SQLExec(goConnectie, lcSQL) - If lnResult > 0 - LogMessage("Partener procesat cu succes: ID=" + Transform(m.lnIdPart), "DEBUG", gcLogFile) - Else - *-- Obtinere detalii eroare Oracle - lcErrorDetails = GetOracleErrorDetails(m.lcSQL) - LogMessage("EROARE la apelul procedurii PACK_IMPORT_PARTENERI.cauta_sau_creeaza_partener pentru: " + lcDenumire + CHR(10) + lcErrorDetails, "ERROR", gcLogFile) + If lnResult <= 0 + gcStepError = lcDenumire + " | " + GetOracleErrorDetails() Endif Catch To loError - LogMessage("EXCEPTIE la procesarea partenerului: " + loError.Message, "ERROR", gcLogFile) + gcStepError = loError.Message Endtry Return m.lnIdPart -ENDFUNC && ProcessPartner +Endfunc -*-- Functie pentru procesarea adresei din billing/shipping +*-- Procesare adresa (fara logging) Function ProcessAddress Lparameters tnIdPart, toAdresa Local lcAdresa, lcTelefon, lcEmail, lcSQL, lnResult, lnIdAdresa lnIdAdresa = 0 - If .F. - TEXT TO lcExampleJsonAdresa NOSHOW - "billing": { - "address": "STR. CAMPUL LINISTII, NR. 1", - "city": "Arad", - "company": { - "bank": "", - "code": "RO30071208", - "iban": "", - "name": "BASSANO BUILDINGS SRL", - "registrationNo": "" - }, - "country": "Romania", - "customerId": "13422", - "email": "office@bassano.ro", - "firstname": "Ionela", - "lastname": "Letcan", - "phone": "0728141899", - "region": "Arad" - }, - "shipping": { - "address": "Strada Molnar Janos nr 23 bloc 37 sc B etj e ap. 16", - "city": "Bra?ov", - "company": "", - "country": "Romania", - "email": "ancamirela74@gmail.com", - "firstname": "Anca", - "lastname": "Stanciu", - "phone": "0758261492", - "region": "Brasov", - "zipcode": "" - } - ENDTEXT - Endif - Try - * Cautare/creare adresa - If !Empty(Nvl(m.tnIdPart,0)) - *-- Formatare adresa pentru Oracle (format semicolon cu prefix JUD:) + If !Empty(Nvl(m.tnIdPart, 0)) lcAdresa = FormatAddressForOracle(toAdresa) - - *-- Date contact lcTelefon = Iif(Type('toAdresa.phone') = 'C', toAdresa.phone, "") lcEmail = Iif(Type('toAdresa.email') = 'C', toAdresa.email, "") - + lcSQL = "BEGIN PACK_IMPORT_PARTENERI.cauta_sau_creeaza_adresa(?tnIdPart, ?lcAdresa, ?lcTelefon, ?lcEmail, ?@lnIdAdresa); END;" - lnResult = SQLExec(goConnectie, lcSQL) - - If lnResult > 0 - LogMessage("Adresa procesata cu succes: ID=" + Transform(m.lnIdAdresa), "DEBUG", gcLogFile) - Else - *-- Obtinere detalii eroare Oracle - lcErrorDetails = GetOracleErrorDetails(m.lcSQL) - LogMessage("EROARE la apelul procedurii PACK_IMPORT_PARTENERI.cauta_sau_creeaza_adresa pentru PartnerId: " + ALLTRIM(TRANSFORM(m.tnIdPart)) + CHR(10) + lcErrorDetails, "ERROR", gcLogFile) - Endif - Endif Catch To loError - LogMessage("EXCEPTIE la procesarea adresei: " + loError.Message, "ERROR", gcLogFile) Endtry Return m.lnIdAdresa -Endfunc && ProcessAddress +Endfunc -*-- Functie pentru construirea JSON-ului cu articole conform package Oracle +*-- Construire JSON articole Function BuildArticlesJSON Lparameters loItems @@ -494,14 +382,13 @@ Function BuildArticlesJSON Try lcJSON = nfjsoncreate(loItems) Catch To loError - LogMessage("EROARE la construirea JSON articole: " + loError.Message, "ERROR", gcLogFile) lcJSON = "" Endtry Return lcJSON Endfunc -*-- Functie pentru curatarea textului web (HTML entities → ASCII simplu) +*-- Curatare text web (HTML entities -> ASCII simplu) Function CleanWebText Parameters tcText Local lcResult @@ -512,41 +399,36 @@ Function CleanWebText lcResult = tcText - *-- Conversie HTML entities in caractere simple (fara diacritice) - lcResult = Strtran(lcResult, 'ă', 'a') && ă → a - lcResult = Strtran(lcResult, 'ș', 's') && ș → s - lcResult = Strtran(lcResult, 'ț', 't') && ț → t - lcResult = Strtran(lcResult, 'î', 'i') && î → i - lcResult = Strtran(lcResult, 'â', 'a') && â → a + lcResult = Strtran(lcResult, 'ă', 'a') + lcResult = Strtran(lcResult, 'ș', 's') + lcResult = Strtran(lcResult, 'ț', 't') + lcResult = Strtran(lcResult, 'î', 'i') + lcResult = Strtran(lcResult, 'â', 'a') lcResult = Strtran(lcResult, '&', '&') lcResult = Strtran(lcResult, '<', '<') lcResult = Strtran(lcResult, '>', '>') lcResult = Strtran(lcResult, '"', '"') - *-- Eliminare tag-uri HTML simple lcResult = Strtran(lcResult, '
', ' ') lcResult = Strtran(lcResult, '
', ' ') lcResult = Strtran(lcResult, '
', ' ') - *-- Eliminare Esc character lcResult = Strtran(lcResult, '\/', '/') Return Alltrim(lcResult) Endfunc -*-- Functie pentru conversia datei web in format Oracle +*-- Conversie data web in format YYYYMMDD Function ConvertWebDate Parameters tcWebDate Local lcResult If Empty(tcWebDate) Or Type('tcWebDate') != 'C' - Return Dtos(Date()) && yyyymmdd + Return Dtos(Date()) Endif - *-- Web date format: "2025-08-27 16:32:43" → "20250827" lcResult = Strtran(Left(tcWebDate, 10), "-", "",1,10,1) - *-- Validare format YYYYMMDD If Len(lcResult) = 8 Return lcResult Else @@ -554,12 +436,9 @@ Function ConvertWebDate Endif Endfunc -*-- Functie pentru conversia datei string in Date -* ldData = String2Date('20250912', ['yyyymmdd']) +*-- Conversie string in Date Function String2Date Lparameters tcDate, tcFormat - * tcDate: 20250911 - * tcFormat: yyyymmdd (default) Local lcAn, lcDate, lcFormat, lcLuna, lcZi, ldData, lnAn, lnLuna, lnZi, loEx ldData = {} @@ -567,19 +446,17 @@ Function String2Date lcDate = m.tcDate lcFormat = Iif(!Empty(m.tcFormat), Alltrim(Lower(m.tcFormat)), 'yyyymmdd') - lcDate = Chrtran(m.lcDate, '-/\','...') && inlocuiesc .-/\ cu . ca sa am doar variante yyyy.mm.dd, dd.mm.yyyy + lcDate = Chrtran(m.lcDate, '-/\','...') lcDate = Strtran(m.lcDate, '.', '', 1, 2, 1) lcFormat = Chrtran(m.lcFormat, '.-/\','...') lcFormat = Strtran(m.lcFormat, '.', '', 1, 2, 1) - Do Case Case m.lcFormat = 'ddmmyyyy' lcAn = Substr(m.tcDate, 5, 4) lcLuna = Substr(m.tcDate, 3, 2) lcZi = Substr(m.tcDate, 1, 2) Otherwise - * yyyymmdd lcAn = Substr(m.tcDate, 1, 4) lcLuna = Substr(m.tcDate, 5, 2) lcZi = Substr(m.tcDate, 7, 2) @@ -597,30 +474,27 @@ Function String2Date Return m.ldData Endfunc -*-- Functie pentru formatarea adresei in format semicolon pentru Oracle +*-- Formatare adresa in format semicolon pentru Oracle Function FormatAddressForOracle Parameters loBilling Local lcAdresa, lcJudet, lcOras, lcStrada - *-- Extragere componente adresa lcJudet = Iif(Type('loBilling.region') = 'C', CleanWebText(loBilling.Region), "") lcOras = Iif(Type('loBilling.city') = 'C', CleanWebText(loBilling.city), "") lcStrada = Iif(Type('loBilling.address') = 'C', CleanWebText(loBilling.address), "") - *-- Format semicolon cu prefix JUD: conform specificatiilor Oracle lcAdresa = "JUD:" + lcJudet + ";" + lcOras + ";" + lcStrada Return lcAdresa Endfunc -*-- Functie pentru construirea observatiilor comenzii +*-- Construire observatii comanda Function BuildOrderObservations Parameters loOrder Local lcObservatii lcObservatii = "" - *-- Informatii plata si livrare If Type('loOrder.payment') = 'O' And Type('loOrder.payment.name') = 'C' lcObservatii = lcObservatii + "Payment: " + CleanWebText(loOrder.Payment.Name) + "; " Endif @@ -629,7 +503,6 @@ Function BuildOrderObservations lcObservatii = lcObservatii + "Delivery: " + CleanWebText(loOrder.delivery.Name) + "; " Endif - *-- Status si sursa If Type('loOrder.status') = 'C' lcObservatii = lcObservatii + "Status: " + CleanWebText(loOrder.Status) + "; " Endif @@ -643,7 +516,6 @@ Function BuildOrderObservations lcObservatii = lcObservatii + "; " Endif - *-- Verificare adrese diferite shipping vs billing If Type('loOrder.shipping') = 'O' And Type('loOrder.billing') = 'O' If Type('loOrder.shipping.address') = 'C' And Type('loOrder.billing.address') = 'C' If !Alltrim(loOrder.shipping.address) == Alltrim(loOrder.billing.address) @@ -657,7 +529,6 @@ Function BuildOrderObservations Endif Endif - *-- Limitare lungime observatii pentru Oracle If Len(lcObservatii) > 500 lcObservatii = Left(lcObservatii, 497) + "..." Endif @@ -665,16 +536,12 @@ Function BuildOrderObservations Return lcObservatii Endfunc -*-- Functie pentru obtinerea detaliilor erorii Oracle +*-- Obtinere detalii eroare Oracle (single-line, fara SQL) Function GetOracleErrorDetails - Lparameters tcSql - * tcSql (optional) : SQL executat - Local lcError, laError[1], lnErrorLines, lnIndex lcError = "" - *-- Obtinere eroare Oracle lnErrorLines = Aerror(laError) If lnErrorLines > 0 For lnIndex = 1 To lnErrorLines @@ -689,12 +556,103 @@ Function GetOracleErrorDetails lcError = "Eroare Oracle nedefinita" Endif - lcError = Iif(Pcount() = 1 And !Empty(m.tcSql) And Type('tcSql') = 'C', m.tcSql + Chr(13) + Chr(10), '') + m.lcError + *-- Compact: inlocuieste newlines cu spatii + lcError = Strtran(lcError, CHR(13) + CHR(10), " ") + lcError = Strtran(lcError, CHR(10), " ") + lcError = Strtran(lcError, CHR(13), " ") Return lcError Endfunc -*-- Functie pentru executia adapter-ului configurat +*-- Clasifica eroarea Oracle intr-un format compact +*-- Returneaza: "SKU_NOT_FOUND: sku" / "PRICE_POLICY: sku" / eroarea bruta +Function ClassifyImportError + Lparameters tcErrorDetails + Local lcText, lcSku, lnPos, lcSearch + + lcText = Iif(Empty(tcErrorDetails), "", tcErrorDetails) + + *-- SKU negasit + lcSearch = "NOM_ARTICOLE: " + lnPos = Atc(lcSearch, lcText) + If lnPos > 0 + lcSku = Alltrim(Getwordnum(Substr(lcText, lnPos + Len(lcSearch)), 1)) + Return "SKU_NOT_FOUND: " + lcSku + Endif + + *-- Eroare adaugare articol (include pretul) + lcSearch = "Eroare adaugare articol " + lnPos = Atc(lcSearch, lcText) + If lnPos > 0 + lcSku = Alltrim(Getwordnum(Substr(lcText, lnPos + Len(lcSearch)), 1)) + Return "PRICE_POLICY: " + lcSku + Endif + + *-- Eroare pret fara SKU (inainte de fix-ul Oracle) + If Atc("Pretul pentru acest articol", lcText) > 0 + Return "PRICE_POLICY: (SKU necunoscut)" + Endif + + *-- Eroare generica - primele 100 caractere + Return Left(lcText, 100) +Endfunc + +*-- Colectare SKU-uri lipsa din mesajele de eroare Oracle +Function CollectFailedSKUs + Lparameters tcErrorDetails + Local lcSku, lnPos, lcSearch, lcText + + If Empty(tcErrorDetails) + Return + Endif + + lcText = tcErrorDetails + + *-- Pattern 1: "SKU negasit in ARTICOLE_TERTI si NOM_ARTICOLE: XXXXX" + lcSearch = "NOM_ARTICOLE: " + lnPos = Atc(lcSearch, lcText) + If lnPos > 0 + lcSku = Alltrim(Getwordnum(Substr(lcText, lnPos + Len(lcSearch)), 1)) + If !Empty(lcSku) + AddUniqueSKU(lcSku) + Endif + Endif + + *-- Pattern 2: "Eroare adaugare articol XXXXX (CODMAT:" sau "Eroare adaugare articol XXXXX:" + lcSearch = "Eroare adaugare articol " + lnPos = Atc(lcSearch, lcText) + If lnPos > 0 + lcSku = Alltrim(Getwordnum(Substr(lcText, lnPos + Len(lcSearch)), 1)) + If !Empty(lcSku) + AddUniqueSKU(lcSku) + Endif + Endif + + Return +Endfunc + +*-- Adauga un SKU in gcFailedSKUs daca nu exista deja +Function AddUniqueSKU + Lparameters tcSku + Local lcSku + lcSku = Alltrim(tcSku) + + If Empty(lcSku) + Return + Endif + + If Empty(gcFailedSKUs) + gcFailedSKUs = lcSku + Else + If !(CHR(10) + lcSku + CHR(10)) $ (CHR(10) + gcFailedSKUs + CHR(10)) + gcFailedSKUs = gcFailedSKUs + CHR(10) + lcSku + Endif + Endif + + Return +Endfunc + +*-- Executie adapter configurat Function ExecuteAdapter Local llSuccess, lcAdapterPath @@ -704,28 +662,15 @@ Function ExecuteAdapter lcAdapterPath = gcAppPath + goSettings.AdapterProgram If File(lcAdapterPath) - LogMessage("Executie adapter: " + lcAdapterPath, "INFO", gcLogFile) Do (lcAdapterPath) llSuccess = .T. - LogMessage("Adapter executat cu succes", "INFO", gcLogFile) Else - LogMessage("EROARE: Adapter-ul nu a fost gasit la: " + lcAdapterPath, "ERROR", gcLogFile) + LogMessage("EROARE: Adapter negasit: " + lcAdapterPath, "ERROR", gcLogFile) Endif Catch To loError - LogMessage("EXCEPTIE la executia adapter-ului " + goSettings.AdapterProgram + ": " + loError.Message, "ERROR", gcLogFile) + LogMessage("EROARE adapter: " + loError.Message, "ERROR", gcLogFile) Endtry Return llSuccess Endfunc - -*-- Orchestrator complet pentru sincronizarea comenzilor web cu Oracle ROA -*-- Caracteristici: -*-- - Citeste JSON-urile generate de gomag-vending.prg -*-- - Proceseaza comenzile cu toate helper functions necesare -*-- - Integreaza cu package-urile Oracle validate in Phase 1 -*-- - Logging complet cu statistici de procesare -*-- - Error handling pentru toate situatiile -*-- - Support pentru toate formatele GoMag (billing/shipping, companii/persoane fizice) - - \ No newline at end of file