Web Hosting by Netfirms | Free Domain Names by Netfirms

Oracle SQL*/PLSQL Examples

rem $DBA/crpacks.sql
rem
rem This script generates another script that will include all the CREATE
rem PACKAGE statements for those in the database (except for the SYS user).
rem
rem Restrictions:
rem	1) This script has been tested for Oracle 7, 8.0.3, and 8.0.4.
rem	2) This script must be run by a user with the DBA role under Oracle 7
rem	   or later.
rem	3) If running on Oracle 7.2, you must comment out the below
rem	   "set trimspool on" line, since it is supported as of Oracle 7.3 and
rem	   later.
rem	4) This routine creates an output file of 80-character lines.  If the
rem	   original objects were created with longer lines than 80, errors may
rem	   occur when the output file is executed, due to the necessary
rem	   wrapping of the long lines in this script, although in the vast
rem	   majority of cases, this script will properly wrap the long lines so
rem	   that they can be successfully processed by Oracle.  If there is a
rem	   problem when wrapping long lines, this script can be modified to
rem	   output 132-column long lines in the output file.
rem
rem Last Change 07/21/98 by Brian Lomasky to add trimspool, add comments, fix
rem				formatting errors, change --- string to +++ (so
rem				SQL*Plus won't think next line is a
rem				continuation of the previous line), add
rem				"show errors" command after every "/", disable
rem				define character in output file.
rem Last Change 01/21/98 by Brian Lomasky to add SPOOL statements in created
rem				file.
rem Created 12/13/96 by Brian Lomasky
rem
set echo off
set feedback off
set pagesize 0
set trimspool on
set verify off
select 'Creating package build script...' from dual;
set termout off
drop table pack_temp;
set termout on
create table pack_temp (	lineno NUMBER,
				text VARCHAR2(80));

declare
	cursor src_cursor is select
		owner,
		name,
		text
		from sys.dba_source
		where owner != 'SYS' and type = 'PACKAGE'
		order by owner, name, line;

	lv_owner		sys.dba_source.owner%TYPE;
	lv_name			sys.dba_source.name%TYPE;
	lv_text			sys.dba_source.text%TYPE;
	lv_lineno		number;
	backwards		number;
	max_length		number;
	real_len		number;
	last_break		number;
	text_length		number;
	startp			number;
	xchar			number;
	dash_pos		number;
	break_pos		number;
	lf_pos			number;
	semi_pos		number;
	offset			number;
	out_start		number;
	l			number;
	bef_chars		varchar2(2000);
	a_lin			varchar2(80);
	prev_owner		sys.dba_source.owner%TYPE;
	prev_name		sys.dba_source.name%TYPE;
	delete_object		number;
	delete_name		number;

	function wri(x_lin in varchar2, x_str in varchar2,
		x_force in number) return varchar2 is
	begin
		if length(x_lin) + length(x_str) > 80
		then
			lv_lineno := lv_lineno + 1;
			insert into pack_temp values (lv_lineno, x_lin);
			if x_force = 0
			then
				return x_str;
			else
				lv_lineno := lv_lineno + 1;
				insert into pack_temp values (lv_lineno, x_str);
				return '';
			end if;
		else
			if x_force = 0
			then
				return x_lin||x_str;
			else
				lv_lineno := lv_lineno + 1;
				insert into pack_temp values (
					lv_lineno, x_lin||x_str);
				return '';
			end if;
		end if;
	end wri;

begin
	a_lin := '';
	lv_lineno := 0;
	prev_owner := '@';
	prev_name := '';
	open src_cursor;
	loop
		<<fetchnext>>
		fetch src_cursor into
			lv_owner,
			lv_name,
			lv_text;
		exit when src_cursor%NOTFOUND;
		if prev_owner != lv_owner or prev_name != lv_name
		then
			if prev_owner != '@' then
				a_lin := wri(a_lin, chr(10) || '/', 1);
				a_lin := wri(a_lin, 'show errors', 1);
				a_lin := wri(a_lin,
					'rem +++++++++++++++++++++++++', 1);
			end if;
			a_lin := wri(a_lin, 'create or replace package ', 0);
			a_lin := wri(a_lin, lv_owner || '.' || lv_name, 1);
			prev_owner := lv_owner;
			prev_name := lv_name;
			delete_object := 1;
			delete_name := 1;
		end if;
		if delete_object = 1 then
			-- Remove the "PACKAGE name" text since we've already
			-- printed that part of the re-creation script
			break_pos := instr(upper(lv_text), 'PACKAGE');
			if break_pos != 0
			then
				delete_object := 0;
				if length(lv_text) < break_pos + 8 then
					goto fetchnext;
				end if;
				lv_text := substr(lv_text, break_pos + 7);
			end if;
		end if;
		if delete_name = 1 then
			-- Remove the "PACKAGE name" text since we've already
			-- printed that part of the re-creation script
			break_pos := instr(upper(lv_text), upper(lv_name));
			if break_pos != 0
			then
				delete_name := 0;
				if length(lv_text) < break_pos +
					length(lv_name) + 1
				then
					goto fetchnext;
				end if;
				lv_text := substr(lv_text, break_pos +
					length(lv_name));
			end if;
		end if;
		-- Remove any trailing "0^B" characters
		break_pos := instr(lv_text, '0' || chr(2));
		if break_pos != 0
		then
			lv_text := substr(lv_text, 1, break_pos - 1);
		end if;
		text_length := nvl(length(lv_text), 0);
		-- Break 2000-char text field into smaller groups to print
		if text_length = 0 then
			a_lin := wri(a_lin, '', 1);
		end if;
		max_length := 80;
		startp := 1;
		while startp <= text_length
		loop
			--
			-- See if line begins with a --
			--
			-- Calculate real length of line that is <= 80 chars
			-- (taking into account that each tab will move to the
			-- next multiple of 8)
			real_len := 0;
			out_start := startp;
			while out_start <= text_length
			loop
				if substr(lv_text, out_start, 1) = chr(9) then
					l := floor(real_len / 8) * 8 + 8 -
						real_len;
				else
					l := 1;
				end if;
				if real_len + l > max_length then
					real_len := out_start - startp;
					exit;
				end if;
				if out_start = text_length then
					real_len := text_length - startp + 1;
					exit;
				end if;
				real_len := real_len + l;
				out_start := out_start + 1;
			end loop;
			-- Break line at last space/tab, semi-colon, linefeed,
			-- "--" comment, comma, tab, 80 chars, or end of string
			break_pos := instr(substr(lv_text, startp, real_len),
				' '||chr(9), -1);
			lf_pos := instr(substr(lv_text, startp, real_len),
				chr(10), -1);
			dash_pos := instr(substr(lv_text, startp, real_len),
				chr(45) || chr(45), -1);
			semi_pos := instr(substr(lv_text, startp, real_len),
				';', -1);
			-- No break at space/tab if no characters come before it
			if break_pos > 0 then
				bef_chars := ltrim(substr(lv_text, startp,
					break_pos - startp + 1));
				if bef_chars is null then
					break_pos := 0;
				end if;
			end if;
			-- See which break is encountered first
			last_break := 0; -- Init position of last break
			if lf_pos > last_break then
				-- Store break right before the linefeed
				last_break := lf_pos - 1;
				offset := 1; -- Skip linefeed
			end if;
			-- Check for break at a comma
			lf_pos := instr(substr(lv_text, startp, real_len),
				',', -1);
			if lf_pos > last_break then
				-- Store break right after the comma
				last_break := lf_pos;
				offset := 0;
			end if;
			if break_pos = 0 then
				-- Check for break at a tab if no space/tab
				-- found
				lf_pos := instr(substr(lv_text, startp,
					real_len), chr(9), -1);
				if lf_pos > last_break then
					-- Store break right before the tab
					last_break := lf_pos - 1;
					offset := 0;
				end if;
			end if;
			if semi_pos > last_break then
				-- Store break right after the semicolon
				last_break := semi_pos;
				offset := 0;
			else
				-- If there is a break at a semi-colon, skip
				-- this break at the tab
				if break_pos > last_break then
					-- Store break right after the space
					last_break := break_pos;
					-- Skip space part of the space/tab
					offset := 1;
				end if;
			end if;
			if dash_pos > last_break then
				-- Do not break if remainder of line <= 80 chars
				if text_length - startp >= real_len then
					-- Store break right before the dashes
					last_break := dash_pos - 1;
					offset := 0;
				end if;
			end if;
			-- No break if rest of line is <= 80 characters
			if real_len = text_length - startp + 1 then
				-- Set to break at end of line
				last_break := real_len;
				offset := 0;
			end if;
			-- Break at the last break that was encountered
			break_pos := last_break;
			-- See if no break position found
			if break_pos = 0 then
				-- Back up to first space
				backwards := 1;
				-- Start looking for break at line end
				break_pos := real_len;
				while backwards = 1
				loop
					-- See if no space found
					if break_pos <= 1 then
						-- Break at 80 chars
						break_pos := real_len;
						backwards := 0;
						exit;
					end if;
					-- See if we found a space
					if substr(lv_text, startp +
						break_pos - 1, 1) = ' '
					then
						backwards := 0;
						exit;
					end if;
					break_pos := break_pos - 1;
				end loop;
			end if;
			xchar := break_pos;
			if xchar = 0 then
				if offset = 0 then
					goto fetchnext;
				end if;
			else
				-- Write output line
				-- See if needing to wrap a long comment
				if max_length = 78 then
					a_lin := wri(a_lin, chr(45) ||
						chr(45) ||
						substr(lv_text, startp, xchar),
						1);
				else
					a_lin := wri(a_lin,
						substr(lv_text, startp, xchar),
						1);
				end if;
			end if;
			-- See if we just found a comment line
			if max_length = 80 then
				if substr(ltrim(substr(lv_text, startp, 132),
					' ' || chr(9)), 1, 2) =
					chr(45) || chr(45)
				then
					max_length := 78;
				else
					max_length := 80;
				end if;
			end if;
			startp := startp + xchar + offset;
		end loop;
	end loop;
	close src_cursor;
	if prev_owner != '@' then
		a_lin := wri(a_lin, chr(10) || '/', 1);
		a_lin := wri(a_lin, 'show errors', 1);
	end if;
end;
/

set termout off
set heading off
spool cr_pack.sql
select 'rem cr_pack.sql' from dual;
select 'rem' from dual;
select 'rem ***** All packages for database ' || name from v$database;
select 'rem' from dual;
select 'set define off' from dual;
select 'set echo on' from dual;
select 'set feedback off' from dual;
select 'set termout on' from dual;
select 'set verify off' from dual;
select 'spool cr_pack.lst' from dual;
select text from pack_temp order by lineno;
select 'spool off' from dual;
spool off
drop table pack_temp;
set termout on
select 'Created cr_pack.sql...' from dual;
set termout off
exit