SET SERVEROUTPUT ON;
CREATE OR REPLACE PACKAGE BODY pls IS
-- utility method (local):
-- enables testing on console
PROCEDURE localPrint(message IN VARCHAR2) IS
BEGIN
htp.print(message);
dbms_output.put_line(message);
END;
-- utility:
PROCEDURE htmlProlog(title IN VARCHAR2) IS
BEGIN
localPrint('<html><head><title>' || title || '</title>');
localPrint('
<style>
<!--
body, h1, h2, h3 {
font-family: sans-serif, helvetica, arial;
}
body {
color: black;
background: white;
}
td.kod {
color: blue;
background: #ffffe0;
}
div.blad {
color: red;
}');
localPrint('
h1 {
color: red;
}
h2, h3, th, a:link, a:visited {
color: black;
}
span.attvalue {
color: brown;
}
span.eltname {
color: green;
}
-->
</style>');
localPrint('</head>');
localPrint('<body><h1>' || title || '</h1><hr>');
END;
-- utility:
PROCEDURE htmlEpilog IS
BEGIN
localPrint('<br><br><br><hr><div align="right">' ||
'<i>&' || 'copy;2001-2002, <a href="http://bienkowski.net">Karol Bienkowski</a></i></div></body></html>');
END;
-- utility:
-- go back to main page
PROCEDURE goBack IS
BEGIN
htmlProlog('Success!');
localPrint('<a href="kb181029.pls.printXML">Go to main page</a>');
htmlEpilog;
END;
-- utility:
PROCEDURE printError IS
BEGIN
htmlProlog('An error occured!');
localPrint('<a href="kb181029.pls.printXML">Go to main page</a>');
htmlEpilog;
END;
-- local:
PROCEDURE printError(message IN VARCHAR2) IS
BEGIN
htmlProlog('Error: <div class="blad">' || message || '</div>');
localPrint('<a href="kb181029.pls.printXML">Go to main page</a>');
htmlEpilog;
END;
-- utility function:
-- prints the specified node using the specified indent to format
-- an XML document on the screen;
-- calls itself recursively to print child nodes
PROCEDURE printNode(id IN NUMBER, indent IN VARCHAR2) IS
p_id NUMBER := id; -- "paramteter id"
CURSOR children IS
SELECT e.id
FROM Elements e
WHERE e.parent = p_id
ORDER BY e.id ;
CURSOR attribs IS
SELECT a.id, a.name, a.value, a.atype
FROM Attributes a
WHERE a.owner = p_id
ORDER BY a.id ;
CURSOR text_ch IS
SELECT t.id, t.value
FROM Texts t
WHERE t.parent = p_id
ORDER BY t.id;
my_name Elements.name%TYPE;
i NUMBER;
string VARCHAR2(4096) := ''; -- the string to print
BEGIN
SELECT e.name INTO my_name
FROM Elements e
WHERE e.id = p_id;
string := '<tr><td class="kod"><tt><b>'; -- 1st column: XML elements and attribs
-- print the element with its attributes.
-- the attributes are links to pages where they can be modified
-- starting tag:
string := string || indent || '&' || 'lt;<span class="eltname">' || my_name || '</span>';
-- attributes:
FOR attrib IN attribs LOOP
string := string || '<br>' || indent || '&' || 'nbsp;&' || 'nbsp;&' || 'nbsp;&' || 'nbsp;' ||
'<a href="kb181029.pls.changeAttributeValueForm?id=' || attrib.id || '">' ||
attrib.name || '</a>="<span class="attvalue">' || attrib.value || '</span>"';
END LOOP;
string := string || '>';
localPrint(string);
-- print child text nodes
FOR text IN text_ch LOOP
localPrint('<br>' || indent || '&' || 'nbsp;&' || 'nbsp;<a href="kb181029.pls.changeTextValueForm?id=' || text.id || '">' ||
text.value || '</a>');
END LOOP;
localPrint('</b></tt></td><td align="center">'); -- 2nd column: links to add new elements
localPrint('+E <a href="kb181029.pls.addElementForm?parent=' || p_id || '">[>]</a>');
localPrint('</td><td align="center">'); -- 3rd column: links to add new attribs
localPrint('+A <a href="kb181029.pls.addAttributeForm?owner=' || p_id || '">[>]</a>');
localPrint('</td><td align="center">'); -- 4th column: links to add new text nodes
localPrint('+T <a href="kb181029.pls.addTextForm?parent=' || p_id || '">[>]</a>');
localPrint('</td><td align="center">'); -- 5th column: links to remove elements
localPrint('-E <a href="kb181029.pls.doDeleteElement?id=' || p_id || '">[>]</a>');
localPrint('</td></tr>');
-- print subelements
FOR child IN children LOOP
printNode(child.id, indent || '&' || 'nbsp;&' || 'nbsp');
END LOOP;
-- ending tag:
localPrint('<tr><td class="kod"><tt><b>');
localPrint(indent || '&' || 'lt;/<span class="eltname">' || my_name || '</span>><br>');
localPrint('</b></tt></td><td colspan="4"></td></tr>');
EXCEPTION
WHEN NO_DATA_FOUND THEN
printError('No such node');
END;
-- main 'display' procedure
-- prints the whole document tree
PROCEDURE printXML IS
root_id NUMBER;
BEGIN
SELECT e.id INTO root_id
FROM Elements e
WHERE e.parent IS NULL;
htmlProlog('The XML Document');
localPrint('<table cellpadding="0" cellspacing="0" border="0">');
localPrint('<tr><th>Source</th><th>Add a subelement |&' || 'nbsp;</th>');
localPrint('<th>Add an attribute |&' || 'nbsp;</th><th>Add a text |&' || 'nbsp;</th><th>Remove the element</th></tr>');
localPrint('<tr><td colspan="5"><br></td></tr>');
localPrint('<tr><td class="kod"><tt><b>&' || 'lt;?xml version="1.0"?></b></tt></td><td colspan="4"></td></tr>');
printNode(root_id, '');
localPrint('</table>');
localPrint('<br><br><a href="kb181029.pls.clearXML">Clear the document</a>');
htmlEpilog;
EXCEPTION
WHEN NO_DATA_FOUND THEN
addElementForm(0);
WHEN OTHERS THEN
printError;
END;
-- local:
PROCEDURE formProlog(action IN VARCHAR2) IS
BEGIN
localPrint('<form action="' || action || '"><table>');
END;
-- local:
PROCEDURE formSubmit IS
BEGIN
localPrint('<tr><td></td><td><input type="submit" name="submit" value="OK - Submit" ' ||
'value="submit"></td></tr>');
END;
-- local:
PROCEDURE formEpilog IS
BEGIN
formSubmit;
localPrint('</table></form>');
END;
-- local:
PROCEDURE formRow(text IN VARCHAR2, name IN VARCHAR2,
value IN VARCHAR2, hidden IN BOOLEAN) IS
BEGIN
IF hidden THEN
localPrint('<tr><td colspan="2"><input type="hidden" name="' ||
name || '" value="' || value || '"></td></tr>');
ELSE
localPrint('<tr><td>' || text || '</td><td><input type="text" name="' ||
name || '" value="' || value || '"></td></tr>');
END IF;
END;
--=== Elements ===--
PROCEDURE addElementForm(parent IN NUMBER) IS
BEGIN
htmlProlog('Add an element');
IF parent = 0 THEN
localPrint('There is no root element. You must add one.');
END IF;
formProlog('kb181029.pls.doAddElement');
formRow('Enter name', 'name', '', false);
formRow('', 'parent', parent, true);
formEpilog;
htmlEpilog;
END;
PROCEDURE doAddElement(parent IN NUMBER, name IN VARCHAR2, submit IN VARCHAR2) IS
-- i ignore a submit parameter, but it doesn't work without it...
new_id NUMBER;
BEGIN
SELECT ElementsSeq.nextVal INTO new_id FROM Sys.Dual;
-- TO DO: check if it is not a duplicate root element
IF parent <= 0 THEN
DELETE FROM Elements e
WHERE e.parent IS NULL;
INSERT INTO Elements VALUES (
new_id, null, name
);
ELSE
INSERT INTO Elements VALUES (
new_id, parent, name
);
END IF;
goBack;
EXCEPTION
WHEN OTHERS THEN
printError;
END;
PROCEDURE doDeleteElement(id IN NUMBER) IS
p_id NUMBER := id;
BEGIN
DELETE FROM Elements e
WHERE e.id = p_id;
goBack;
EXCEPTION
WHEN OTHERS THEN
printError;
END;
--=== Attributes ===--
PROCEDURE addAttributeForm(owner IN NUMBER) IS
CURSOR attr_types IS
SELECT t.id AS id, t.name AS name
FROM AttrTypes t;
BEGIN
htmlProlog('Add an attribute');
formProlog('kb181029.pls.doAddAttribute');
formRow('Enter name', 'name', '', false);
formRow('Enter value', 'value', '', false);
formRow('', 'owner', owner, true);
localPrint('<tr><td>Select type</td><td><select name="atype">');
FOR attr_type IN attr_types LOOP
localPrint('<option>' || attr_type.name);
-- option's name isn't used
END LOOP;
localPrint('</select></td></tr>');
formEpilog;
htmlEpilog;
EXCEPTION
WHEN OTHERS THEN
printError;
END;
PROCEDURE doAddAttribute(owner IN NUMBER, name IN VARCHAR2,
value IN VARCHAR2, atype IN VARCHAR2, submit IN VARCHAR2) IS
new_id NUMBER;
att_typid NUMBER;
BEGIN
SELECT t.id INTO att_typid
FROM AttrTypes t
WHERE t.name = atype;
SELECT AttributesSeq.nextVal INTO new_id
FROM Sys.Dual;
INSERT INTO Attributes VALUES (
new_id, owner, name, value, att_typid
);
goBack;
EXCEPTION
WHEN OTHERS THEN
printError;
END;
PROCEDURE changeAttributeValueForm(id IN NUMBER) IS
a_name Attributes.name%TYPE;
a_value Attributes.value%TYPE;
a_type AttrTypes.name%TYPE;
p_id NUMBER := id;
BEGIN
SELECT a.name, a.value, t.name INTO a_name, a_value, a_type
FROM Attributes a, AttrTypes t
WHERE a.id = p_id
AND a.atype = t.id;
htmlProlog('Change the attributes value');
localPrint('Attribute "' || a_name || '" : ' || a_type || '<br>');
formProlog('kb181029.pls.doChangeAttributeValue');
formRow('Enter new value', 'value', a_value, false);
formRow('', 'id', p_id, true);
formEpilog;
localPrint('<br><br><br><a href="kb181029.pls.doDeleteAttribute?id=' || p_id ||
'">Delete this attribute</a>');
htmlEpilog;
EXCEPTION
WHEN NO_DATA_FOUND THEN
printError('No such attribute<br>');
WHEN OTHERS THEN
printError;
END;
PROCEDURE doChangeAttributeValue(id IN NUMBER, value IN VARCHAR2, submit IN VARCHAR2) IS
p_id NUMBER := id;
p_value Attributes.value%TYPE := value;
BEGIN
UPDATE Attributes a
SET a.value = p_value
WHERE a.id = p_id;
goBack;
EXCEPTION
WHEN OTHERS THEN
printError;
END;
PROCEDURE doDeleteAttribute(id IN NUMBER) IS
p_id NUMBER := id;
BEGIN
DELETE FROM Attributes a
WHERE a.id = p_id;
goBack;
EXCEPTION
WHEN OTHERS THEN
printError;
END;
--=== Text Nodes ====--
PROCEDURE addTextForm(parent IN NUMBER) IS
BEGIN
htmlProlog('Add a text node');
formProlog('kb181029.pls.doAddText');
formRow('Enter value', 'value', '', false);
formRow('', 'parent', parent, true);
formEpilog;
htmlEpilog;
END;
PROCEDURE doAddText(parent IN NUMBER, value IN VARCHAR2, submit IN VARCHAR2) IS
new_id NUMBER;
BEGIN
SELECT ElementsSeq.nextVal INTO new_id
FROM Sys.Dual;
INSERT INTO Texts VALUES (
new_id, parent, value
);
goBack;
EXCEPTION
WHEN OTHERS THEN
printError;
END;
PROCEDURE changeTextValueForm(id IN NUMBER) IS
t_value Texts.value%TYPE;
p_id NUMBER := id;
BEGIN
SELECT t.value INTO t_value
FROM Texts t
WHERE t.id = p_id;
htmlProlog('Change the texts node value');
formProlog('kb181029.pls.doChangeTextValue');
formRow('Enter new value', 'value', t_value, false);
formRow('', 'id', p_id, true);
formEpilog;
localPrint('<br><br><br><a href="kb181029.pls.doDeleteText?id=' || p_id ||
'">Delete this text node</a>');
htmlEpilog;
EXCEPTION
WHEN NO_DATA_FOUND THEN
printError('No such attribute<br>');
WHEN OTHERS THEN
printError;
END;
PROCEDURE doChangeTextValue(id IN NUMBER, value IN VARCHAR2, submit IN VARCHAR2) IS
p_id NUMBER := id;
p_value Attributes.value%TYPE := value;
BEGIN
UPDATE Texts t
SET t.value = p_value
WHERE t.id = p_id;
goBack;
EXCEPTION
WHEN OTHERS THEN
printError;
END;
PROCEDURE doDeleteText(id IN NUMBER) IS
p_id NUMBER := id;
BEGIN
DELETE FROM Texts a
WHERE a.id = p_id;
goBack;
EXCEPTION
WHEN OTHERS THEN
printError;
END;
--=== Other ===--
PROCEDURE clearXML IS
BEGIN
DELETE FROM Attributes;
DELETE FROM Elements;
goBack;
EXCEPTION
WHEN OTHERS THEN
printError;
END;
END pls;
/
-- show errors ;
GRANT EXECUTE ON pls TO scott;