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 This script must be run by a user with the DBA role under Oracle7.
rem
rem Created 12/13/96 by Brian Lomasky
rem
set verify off
set feedback off
set echo off
set pagesize 0
set termout on
select 'Creating package build script...' from dual;
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;
	text_length		number;
	startp			number;
	xchar			number;
	first_break		number;
	dash_pos		number;
	break_pos		number;
	lf_pos			number;
	semi_pos		number;
	backwords		number;
	new_line		number;
	offset			number;
	out_start		number;
	out_len			number;
	l			number;
	bef_chars		varchar2(2000);
	out_line		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,
					'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
		startp := 1;
		while startp <= text_length
		loop
			-- Break line at next space/tab, semi-colon, linefeed,
			-- "--" comment, 80 chars, or end of string
			break_pos := instr(lv_text, ' '||chr(9), startp);
			lf_pos := instr(lv_text, chr(10), startp);
			dash_pos := instr(lv_text, '-- ', startp);
			semi_pos := instr(lv_text, ';', startp);
			-- 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
			backwords := 0; -- Assume not backing up to first space
			new_line := 1;  -- Assume forcing a new line
			first_break := 9999; -- Init position of first break
			if lf_pos != 0 and lf_pos < first_break then
				-- Store break right before the linefeed
				first_break := lf_pos;
				offset := 1; -- Skip linefeed
			end if;
			if semi_pos != 0 and semi_pos < first_break then
				-- Store break right after the semicolon
				first_break := semi_pos + 1;
				offset := 0;
			end if;
			if break_pos != 0 and break_pos < first_break then
				-- If there is a break at a semi-colon, and
				-- the line before the semi-colon is less than
				-- 80 characters, skip this break at the tab
				if first_break != semi_pos + 1 or
					first_break - startp > 79
				then
					-- Store break right after the space
					first_break := break_pos + 1;
					-- Skip space part of the space/tab
					offset := 1;
				end if;
			end if;
			if dash_pos != 0 and dash_pos < first_break then
				-- Do not break if remainder of line < 80 chars
				if text_length - startp > 79 then
					-- Store break right before the dashes
					first_break := dash_pos;
					offset := 0;
					-- Special situation if comment is at
					-- start of the section of the line we
					-- are searching at
					if dash_pos = startp then
						-- Set to break line every 80
						-- chars
						first_break := 9999;
					end if;
				end if;
			end if;
			-- If previous break before dashes is a semi-colon,
			-- and the remainder of the line is < 80 characters,
			-- skip the semi-colon break so that the comment will
			-- appear on the same line
			if dash_pos != 0 and semi_pos != 0 and
				text_length - startp < 80 and
				first_break = semi_pos + 1
			then
				-- Set to break at end of line
				first_break := 9999;
			end if;
			if first_break = 9999 then
				-- Break line at 80 characters
				first_break := startp + 80;
				if break_pos > text_length then
					break_pos := text_length + 1;
				end if;
				-- Back up to first space
				backwords := 1;
				-- Do not force new line
				new_line := 0;
			end if;
			-- Break at the first break that is encountered
			break_pos := first_break;
			-- Ensure a maximum break size of 80 characters
			if break_pos - startp > 80 then
				break_pos := startp + 79;
				if break_pos > text_length then
					break_pos := text_length + 1;
				end if;
				-- Back up to first space
				backwords := 1;
			end if;
			while backwords = 1
			loop
				if break_pos > text_length then
					backwords := 0;
					exit;
				end if;
				if break_pos <= startp then
					break_pos := startp + 79;
					if break_pos > text_length then
						break_pos := text_length + 1;
					end if;
					backwords := 0;
					exit;
				end if;
				if substr(lv_text, break_pos, 1) = ' ' then
					backwords := 0;
					exit;
				end if;
				break_pos := break_pos - 1;
			end loop;
			xchar := break_pos - startp;
			if xchar = 0 then
				if offset = 0 then
					goto fetchnext;
				end if;
			else
				-- Replace all tabs with 8 spaces in output line
				out_line := replace(substr(lv_text, startp,
					xchar), chr(9), '        ');
				-- In case replacing the tabs with spaces caused
				-- the output line to exceed 80 chars, write
				-- 80-col pieces of the translated output line
				out_start := 1;
				l := length(out_line);
				if l is null then
					goto fetchnext;
				end if;
				while out_start <= l
				loop
					-- Write output line
					if l >= out_start + 79 then
						out_len := 80;
					else
						out_len := l - out_start + 1;
					end if;
					a_lin := wri(a_lin,
						substr(out_line, out_start,
						out_len), new_line);
					out_start := out_start + out_len;
				end loop;
			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);
	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 feedback off' from dual;
select text from pack_temp order by lineno;
spool off
drop table pack_temp;
set termout on
select 'Created cr_pack.sql...' from dual;
set termout off
exit