Rem  /* Copyright (c) 1994 by M.Lonnroth, Oracle Corp.  All Rights Reserved */
Rem
Rem /***
Rem   NAME
Rem     ht - Hyper Text packages
Rem   PURPOSE
Rem     Provide utility functions for producing HTML documents
Rem     from pl/sql.
Rem   NOTES
Rem     This is implemented as two packages due to limitations in pl/sql
Rem     (unable to invoke function as procedure). 
Rem     htf - All definitions return varchar2
Rem     htp - Procedure calls
Rem
Rem     dbms_output is used to write back output. htp.print() is the
Rem     actual print-function, which will attempt to recover from line-
Rem     overflow by invoking itself recursively (very optimistic), and
Rem     attempt to recover from buffer-overflow by increasing the output
Rem     buffer.
Rem   HISTORY
Rem     mloennro - Sep 5, 1994: Created.
Rem     $Log: ht.sql,v $
Rem Revision 1.7  1995/02/03  15:01:48  mloennro
Rem Fixed bug in formSelectOption
Rem
Rem Revision 1.6  1995/01/11  09:48:55  mloennro
Rem Changed POST to uppercase in formOpen()
Rem
Rem Revision 1.5  1994/12/16  13:45:23  mloennro
Rem added formPassword
Rem
Rem Revision 1.4  1994/10/18  12:08:09  mloennro
Rem added formHidden
Rem
Rem Revision 1.3  1994/09/19  20:43:04  mloennro
Rem syntax bugs in formField & formCheckbox
Rem
Rem Revision 1.2  1994/09/07  05:37:52  mloennro
Rem Added form functions
Rem 
Rem Revision 1.1  1994/09/05  21:50:56  mloennro
Rem Initial revision
Rem
Rem ***/

prompt Package htf...
create or replace package htf as
-- Functions
function title(ctitle in varchar2) return varchar2;
function htitle(ctitle in varchar2) return varchar2;
function header(nsize  in integer, cheader in varchar2) return varchar2;
function url(curl in varchar2, cname in varchar2) return varchar2;
function url_top(curl in varchar2, cname in varchar2) return varchar2;
function url_right(curl in varchar2, cname in varchar2) return varchar2;
function gif(curl in varchar2) return varchar2;
function gif(curl in varchar2, calign  in varchar2) return varchar2;
function bold(ctext in varchar2) return varchar2;
function italic(ctext in varchar2) return varchar2;
function formOpen(curl in varchar2) return varchar2;
function formHidden(cname in varchar2, cvalue in varchar2) return varchar2;
function formPassword(cname in varchar2, cvalue in varchar2) return varchar2;
function formPassword(cname in varchar2) return varchar2;
function formField(cname in varchar2, cvalue in varchar2) return varchar2;
function formField(cname in varchar2, nsize in integer) return varchar2;
function formField(cname in varchar2) return varchar2;
function formText(cname in varchar2, nrow in integer, ncol in integer) return varchar2;
function formCheckbox(cname in varchar2) return varchar2;
function formRadio(cname in varchar2, cval in varchar2) return varchar2;
function formSelectOpen(cname in varchar2) return varchar2;
function formSelectOption(cval in varchar2) return varchar2;
function formDo(cname in varchar2) return varchar2;
function formDo return varchar2;
function formUndo(cname in varchar2) return varchar2;
function formUndo return varchar2;

-- Constants
line       constant varchar2(4) := '<hr>';
para       constant varchar2(3) := '<p>';
nl         constant varchar2(4) := '<br>';
item       constant varchar2(4) := '<li>';
ulistOpen  constant varchar2(4) := '<ul>';
ulistClose constant varchar2(5) := '</ul>';
olistOpen  constant varchar2(4) := '<ol>';
olistClose constant varchar2(5) := '</ol>';
dlistOpen  constant varchar2(4) := '<dl>';
dlistClose constant varchar2(5) := '</dl>';
dterm      constant varchar2(4) := '<dt>';
ddef       constant varchar2(4) := '<dd>';
formSelectClose constant varchar2(9) := '</select>';
formClose  constant varchar2(7) := '</form>';
preOpen    constant varchar2(5) := '<pre>';
preClose   constant varchar2(6) := '</pre>';

end;
.
/
show errors

create or replace package body htf as

function title  (ctitle in varchar2) return varchar2 is
begin return ('<title>' || ctitle || '</title>'); end;

function htitle (ctitle in varchar2) return varchar2 is
begin return (title(ctitle) || header(1,ctitle)); end;

function header (nsize  in integer,  cheader in varchar2)  return varchar2 is
	ch varchar2(2);
begin
	ch := 'h' || to_char(least(abs(nsize),6));
	return('<' || ch || '>' || cheader || '</' || ch || '>');
end;

function url    (curl   in varchar2, cname   in varchar2) return varchar2 is
begin return('<a href="' || curl || '">' || cname || '</a>'); end;

function url_top    (curl   in varchar2, cname   in varchar2) return varchar2 is
begin return('<a href="' || curl || '" TARGET="_top">' || cname || '</a>'); end;

function url_right    (curl   in varchar2, cname   in varchar2) return varchar2 is
begin return('<a href="' || curl || '" TARGET="right">' || cname || '</a>'); end;

function gif    (curl   in varchar2) return varchar2 is
begin return('<img src="' || curl || '">'); end;

function gif    (curl   in varchar2, calign  in varchar2) return varchar2 is
begin return('<img src="' || curl || '" align="' || calign || '">'); end;

function bold   (ctext  in varchar2) return varchar2 is
begin return('<b>' || ctext || '</b>' ); end;

function italic (ctext  in varchar2) return varchar2 is
begin return('<i>' || ctext || '</i>' ); end;

function formOpen(curl in varchar2) return varchar2 is
begin return('<form action="' || curl || '" method="POST">'); end;

function formHidden(cname in varchar2, cvalue in varchar2) return varchar2 is
begin 
   return('<input type="hidden" name="' || cname || '" value="' || 
          cvalue || '">'); 
end;

function formPassword(cname in varchar2, cvalue in varchar2) return varchar2 is
begin
   return('<input type="password" name="' || cname || '" value="' || 
          cvalue || '">'); 
end;

function formPassword(cname in varchar2) return varchar2 is
begin 
   return('<input type="password" name="' || cname || '">');
end;

function formField(cname in varchar2, cvalue in varchar2) return varchar2 is
begin
   return('<input type="text" name="' || cname || '" value="' || 
          cvalue || '">');
end;

function formField(cname in varchar2, nsize in integer) return varchar2 is
begin 
   return('<input type="text" name="' || cname || '" size="' || 
          to_char(nsize) || '">');
end;

function formField(cname in varchar2) return varchar2 is
begin return('<input type="text" name="' || cname || '">'); end;

function formText(cname in varchar2, nrow in integer, ncol in integer) 
return varchar2 is
begin 
	return('<textarea name="' || cname || '" rows=' || 
		to_char(nrow) || ' col=' || to_char(ncol));
end;

function formCheckbox(cname in varchar2) return varchar2 is
begin 
	return('<input type="checkbox" name="' || cname || '">');
end;

function formRadio(cname in varchar2, cval in varchar2) return varchar2 is
begin
	return('<input type="radio" name="' || cname ||
		'" value="' || cval || '">');
end;

function formSelectOpen(cname in varchar2) return varchar2 is
begin return('<select name="' || cname || '">'); end;

function formSelectOption(cval in varchar2) return varchar2 is
begin return('<option>' || cval); end;

function formDo(cname in varchar2) return varchar2 is
begin return('<input type="submit" value="' || cname || '">'); end;

function formDo return varchar2 is
begin return(formDo('Submit')); end;

function formUndo(cname in varchar2) return varchar2 is
begin return('<input type="reset" value="' || cname || '">'); end;

function formUndo return varchar2 is
begin return(formUndo('Reset')); end;

end;
.
/
show errors

prompt Package htp...
create or replace package htp as

-- Procedures
procedure title  (ctitle in varchar2)                      ;
procedure htitle (ctitle in varchar2)                      ;
procedure header (nsize  in integer,  cheader in varchar2) ;
procedure url    (curl   in varchar2, cname   in varchar2) ;
procedure gif    (curl   in varchar2)                      ;
procedure gif    (curl   in varchar2, calign  in varchar2) ;
procedure bold   (ctext  in varchar2)                      ;
procedure italic (ctext  in varchar2)                      ;
procedure item(cval in varchar2);
procedure formOpen(curl in varchar2);
procedure formHidden(cname in varchar2, cvalue in varchar2);
procedure formPassword(cname in varchar2, cvalue in varchar2);
procedure formPassword(cname in varchar2);
procedure formField(cname in varchar2, nsize in integer);
procedure formField(cname in varchar2);
procedure formField(cname in varchar2, cvalue in varchar2);
procedure formText(cname in varchar2, nrow in integer, ncol in integer); 
procedure formCheckbox(cname in varchar2);
procedure formRadio(cname in varchar2, cval in varchar2);
procedure formSelectOpen(cname in varchar2);
procedure formSelectOption(cval in varchar2);
procedure formSelectClose;
procedure formDo(cname in varchar2);
procedure formDo;
procedure formUndo(cname in varchar2);
procedure formUndo;
procedure formClose;

-- Output Procedures
procedure print (cbuf in varchar2);
procedure print (dbuf in date);
procedure print (nbuf in number);

-- Abbrev call to print()
procedure p (cbuf in varchar2);
procedure bp(str in varchar2);
procedure p (dbuf in date);
procedure p (nbuf in number);

-- Constants
procedure line;
procedure para;
procedure nl;
procedure item;
procedure ulistOpen;
procedure ulistClose;
procedure olistOpen;
procedure olistClose;
procedure dlistOpen;
procedure dlistClose;
procedure dterm;
procedure ddef;
procedure preOpen;
procedure preClose;

-- Debug flag; set to tru to see exception-handling in print()
dbg boolean := false;
end;
.
/
show errors
create or replace package body htp as

bufSize integer;

procedure print (cbuf in varchar2) is
--    -20000, ORU-10027: buffer overflow, limit of <buf_limit> bytes.
--    -20000, ORU-10028: line length overflow, limit of 255 bytes per line.
	dbms_output_error exception;
	pragma exception_init(dbms_output_error,-20000);
begin
	dbms_output.put_line(cbuf);
exception
	when dbms_output_error then
	if substr(sqlerrm,12,9) = 'ORU-10027' then
		if bufSize < 1000000 then
			bufSize := bufSize + 100000;
			dbms_output.enable(bufSize);
			if dbg then
				print('***Handled exception ORU-10027***');
			end if;
			print(cbuf);
		else
			-- OK, give up - exceeded max buffer size
			raise;
		end if;
	elsif substr(sqlerrm,12,9) = 'ORU-10028' then
		if length(cbuf) > 0 then
			print(substr(cbuf,1,255));
			if dbg then
				print('***Handled exception ORU-10028***');
			end if;
			print(substr(cbuf,255));
		end if;
	end if;
end;

procedure print (dbuf in date) is
begin print(to_char(dbuf)); end;

procedure print (nbuf in number) is
begin print(to_char(nbuf)); end;

procedure p (cbuf in varchar2) is
begin print(cbuf); end;

procedure bp(str in varchar2) is
       --need to handle long strings..the simple-minded solution: print
       --in blocks of, say, 100, will not work since that adds in
       --a chr(13)chr(10) pair which, in the html formatting, introduces
       --a space and, if string is being modified, corrupts string.
       --     Rather, we split on chr(10)..procedure could be enhanced
       --to search for other acceptable break points (eg at spaces) but this    
       --meets my current needs since all long strings have newlines within
       --every 255chars in my tables.
       --   NOTE: since we print straight from here, str may need to 
       --include formatting tags..recall that PL/SQL varchar2 can be
       --longer than in DB itself    
             s varchar2(32000);
             len number;
             ind number;
         begin
--		htp.p(substr(str,1,254));
		--return;
             s:=str;
             len:=length(s);
             while len>255
             loop
                     ind:=instr(s,chr(13));
		     if (ind = 0) then
			ind := instr(s,chr(10));	
                     	htp.p(substr(s,1,ind-1));
                     	s:=substr(s,ind+1);
		     else
                     	htp.p(substr(s,1,ind-1));
                     	s:=substr(s,ind+2);
		     end if;
                     len:=length(s);
             end loop;
             if len>0 then
                     htp.p(s);
             end if;
         end;

procedure p (dbuf in date) is
begin print(to_char(dbuf)); end;

procedure p (nbuf in number) is
begin print(to_char(nbuf)); end;

procedure title  (ctitle in varchar2) is
begin p(htf.title(ctitle)); end;

procedure htitle (ctitle in varchar2) is
begin p(htf.htitle(ctitle)); end;

procedure header (nsize  in integer,  cheader in varchar2)  is
begin p(htf.header(nsize,cheader)); end;

procedure url    (curl   in varchar2, cname   in varchar2)  is
begin p(htf.url(curl,cname)); end;

procedure url_top    (curl   in varchar2, cname   in varchar2)  is
begin p(htf.url_top(curl,cname)); end;

procedure url_right    (curl   in varchar2, cname   in varchar2)  is
begin p(htf.url_right(curl,cname)); end;

procedure gif    (curl   in varchar2) is
begin p(htf.gif(curl)); end;

procedure gif    (curl   in varchar2, calign  in varchar2)  is
begin p(htf.gif(curl,calign)); end;

procedure bold   (ctext  in varchar2) is
begin p(htf.bold(ctext)); end;

procedure italic (ctext  in varchar2) is
begin p(htf.italic(ctext)); end;

procedure line is 
begin p(htf.line); end;

procedure para is
begin p(htf.para); end;

procedure nl is
begin p(htf.nl); end;

procedure item(cval in varchar2) is
begin p(htf.item || cval); end;

procedure item is
begin p(htf.item); end;

procedure ulistOpen is
begin p(htf.ulistOpen); end;

procedure ulistClose is
begin p(htf.ulistClose); end;

procedure olistOpen is
begin p(htf.olistOpen); end;

procedure olistClose is
begin p(htf.olistClose); end;

procedure dlistOpen is
begin p(htf.dlistOpen); end;

procedure dlistClose is
begin p(htf.dlistClose); end;

procedure dterm is
begin p(htf.dterm); end;

procedure ddef is
begin p(htf.ddef); end;

procedure formOpen(curl in varchar2) is
begin p(htf.formOpen(curl)); end;

procedure formHidden(cname in varchar2, cvalue in varchar2) is
begin p(htf.formHidden(cname,cvalue)); end;

procedure formPassword(cname in varchar2, cvalue in varchar2) is
begin p(htf.formPassword(cname,cvalue)); end;

procedure formPassword(cname in varchar2) is
begin p(htf.formPassword(cname)); end;

procedure formField(cname in varchar2, cvalue in varchar2) is
begin p(htf.formField(cname,cvalue)); end;

procedure formField(cname in varchar2, nsize in integer) is
begin p(htf.formField(cname,nsize)); end;

procedure formField(cname in varchar2) is
begin p(htf.formField(cname)); end;

procedure formText(cname in varchar2, nrow in integer, ncol in integer) is
begin p(htf.formText(cname,nrow,ncol)); end;
 
procedure formCheckbox(cname in varchar2) is
begin p(htf.formCheckbox(cname)); end;

procedure formRadio(cname in varchar2, cval in varchar2) is
begin p(htf.formRadio(cname,cval)); end;

procedure formSelectOpen(cname in varchar2) is
begin p(htf.formSelectOpen(cname)); end;

procedure formSelectOption(cval in varchar2) is
begin p(htf.formSelectOption(cval)); end;

procedure formSelectClose is
begin p(htf.formSelectClose); end;

procedure formDo(cname in varchar2) is
begin p(htf.formDo(cname)); end;

procedure formDo is
begin p(htf.formDo); end;

procedure formUndo(cname in varchar2) is
begin p(htf.formUndo(cname)); end;

procedure formUndo is
begin p(htf.formUndo); end;

procedure formClose is
begin p(htf.formClose); end;

procedure preOpen is
begin p(htf.preOpen); end;

procedure preClose is
begin p(htf.preClose); end;

-- Initialize
begin
	bufSize := 1000000;
	dbms_output.enable(bufSize);
end;
.
/
show errors