The body of this package:

CREATE OR REPLACE package body plsql_archiver<br />as<br />-- forward declarations (implementation is at the end of the package body)<br />function get_code<br />( p_name in varchar2<br />) return clob<br />;<br />function get_errors<br />( p_name in varchar2<br />, p_type in varchar2<br />) return clob<br />;<br />--<br />procedure archive_version<br />( p_object_name   in  varchar2<br />, p_object_type   in  varchar2<br />, p_object_owner  in varchar2<br />, p_creation_time in date<br />) is<br />  l_code clob;<br />  l_object_type varchar2(32):= p_object_type;<br />  l_archive_rec plsql_archive%rowtype;<br />  l_rowid rowid;<br />  l_errors clob;<br />  procedure debug<br />  ( p_txt in varchar2<br />  ) is<br />  begin<br />    dbms_output.put_line(substr(p_txt,1,255));<br />  end;<br />  -- this function tries to locate the specified keyword in the current code block; if the keyword is found,<br />  -- the string following the keyword until the first newline character (chr(10)) is returned<br />  function get_annotation<br />  ( p_keyword in varchar2 -- values include: version, author, branch, comments, priority<br />  ) return varchar2<br />  is<br />    l_pos    number(5); -- position of the keyword, including the @ character<br />    l_pos2   number(5); -- position of the first chr(10) following the keyword<br />    l_return varchar2(4000);<br />  begin<br />    debug(p_keyword);<br />    l_pos:= instr( l_code, '@'||p_keyword);<br />    debug('pos of keyword in code '||l_pos);<br />    if l_pos &gt; 0<br />    then<br />      l_pos2:= instr( l_code, chr(10), l_pos, 1); -- find the first instance of chr(10), starting from position l_pos in the l_code block<br />      debug( 'Position of chr(10) after keyword '||l_pos2);<br />      if l_pos2 &gt; 0<br />      then<br />        l_return:= ltrim(substr( l_code, l_pos + length(p_keyword)+2, l_pos2 - (l_pos + length(p_keyword)+2))); <br />        debug('return value '||l_return);<br />      end if;<br />    end if;<br />    return l_return;<br />  end get_annotation;<br />begin<br />  l_archive_rec.object_name:= p_object_name;<br />  l_archive_rec.object_type:= p_object_type;<br />  l_archive_rec.object_owner:= p_object_owner;<br />  l_archive_rec.creation_time:= sysdate;<br />  if l_object_type = 'PACKAGE BODY'<br />  then<br />    l_object_type:= 'PACKAGE';<br />    -- make sure that dbms_metadata does return the package body <br />    DBMS_METADATA.SET_TRANSFORM_PARAM <br />    ( transform_handle  =&gt; dbms_metadata.SESSION_TRANSFORM<br />    , name              =&gt; 'BODY'<br />    , value             =&gt; true<br />    , object_type       =&gt; 'PACKAGE'<br />    );<br />    -- make sure that dbms_metadata does not return the package specification as well<br />    DBMS_METADATA.SET_TRANSFORM_PARAM <br />    ( transform_handle  =&gt; dbms_metadata.SESSION_TRANSFORM<br />    , name              =&gt; 'SPECIFICATION'<br />    , value             =&gt; false<br />    , object_type       =&gt; 'PACKAGE'<br />    );<br />  elsif l_object_type = 'PACKAGE'<br />  then<br />    -- make sure that dbms_metadata does return the package body <br />    DBMS_METADATA.SET_TRANSFORM_PARAM <br />    ( transform_handle  =&gt; dbms_metadata.SESSION_TRANSFORM<br />    , name              =&gt; 'BODY'<br />    , value             =&gt; false<br />    , object_type       =&gt; 'PACKAGE'<br />    );<br />    -- make sure that dbms_metadata does not return the package specification as well<br />    DBMS_METADATA.SET_TRANSFORM_PARAM <br />    ( transform_handle  =&gt; dbms_metadata.SESSION_TRANSFORM<br />    , name              =&gt; 'SPECIFICATION'<br />    , value             =&gt; true<br />    , object_type       =&gt; 'PACKAGE'<br />    );  <br />  end if;<br />  begin<br />    l_code:= dbms_metadata.get_ddl(l_object_type, p_object_name, p_object_owner);<br />  exception<br />    when others<br />    then<br />      l_archive_rec.comments:= sqlerrm;<br />      l_code:= get_code(p_object_name);<br />  end;<br />  l_archive_rec.source_size:= length(l_code);<br />  l_errors:=  get_errors( p_name =&gt; p_object_name, p_type =&gt; p_object_type);<br />  l_archive_rec.source:=  get_code( p_name =&gt; p_object_name);<br />  l_archive_rec.errors:=  l_errors;<br />  begin<br />    select status<br />    into   l_archive_rec.status<br />    from   all_objects<br />    where  object_name = p_object_name<br />    and    object_type = p_object_type<br />    ;<br />  exception<br />    when others <br />	then <br />	  if l_errors is null or length(l_errors) &lt;2<br />	  then<br />	     l_archive_rec.status:= 'VALID';<br />	  else<br />	     l_archive_rec.status:= 'INVALID';<br />	  end if; <br />  end;<br />  l_archive_rec.version_label:=  get_annotation('version');<br />  l_archive_rec.comments:=  get_annotation('comments');<br />  l_archive_rec.branch:=  get_annotation('branch');<br />  l_archive_rec.priority:=  get_annotation('priority');<br />  l_archive_rec.author:=  get_annotation('author');<br />  -- find the max seq for objects on the same branch with the same version label<br />  -- this assumes that either no version labels are used at all or that every object has a version label <br />  -- and it is only changed once in a while when a new meaningful stage has been reached for a particular object<br />  select nvl(max(seq),0)+1<br />  into   l_archive_rec.seq<br />  from   plsql_archive<br />  where  object_name = l_archive_rec.object_name<br />  and    object_type = l_archive_rec.object_type<br />  and    object_owner = l_archive_rec.object_owner<br />  and    nvl(branch,'MAIN') = nvl(l_archive_rec.branch,'MAIN')<br />  and    nvl(version_label, 'x.y') = nvl(l_archive_rec.version_label, 'x.y')<br />  ;  <br />  insert into plsql_archive<br />  values l_archive_rec<br />  returning rowid into l_rowid;<br />end archive_version;<br /><br />procedure revert_to_previous_version -- undo last change; can be called repeatedly<br />( p_object_name   in  varchar2<br />, p_object_type   in  varchar2<br />, p_object_owner  in varchar2<br />, p_purge_latest  in varchar2 default 'Y' <br />) is<br />  l_source clob;<br /> procedure debug<br />  ( p_txt in varchar2<br />  ) is<br />  begin<br />    dbms_output.put_line(substr(p_txt,1,255));<br />  end;<br /> begin<br />  select source<br />  into   l_source<br />  from   ( select pae.source<br />           ,      row_number() over (partition by object_name, object_type, object_owner <br />		                             order by creation_time desc) rn   <br />           from   plsql_archive pae<br />           where  object_name = p_object_name<br />           and    object_type = p_object_type<br />           and    object_owner = p_object_owner<br />		 ) all_versions<br />  where rn = 2<br />  ;<br />  if p_purge_latest = 'Y'<br />  then <br />    -- delete last version from plsql_archive<br />    delete <br />    from  plsql_archive<br />    where rowid = ( select latest_version.rowid<br />                    from   ( select pae.rowid<br />                             ,      row_number() over (partition by object_name, object_type, object_owner <br />	   	                                               order by creation_time desc) rn   <br />                             from   plsql_archive pae<br />                             where  object_name = p_object_name<br />                             and    object_type = p_object_type<br />                             and    object_owner = p_object_owner<br />                     		) latest_version				<br />                    where rn = 1<br />				  )<br />  ;<br />  end if;    <br />  debug(l_source);<br />  -- create plsql object based on current source<br />  execute immediate 'create or replace '||cast( l_source as varchar2);<br /> <br />end revert_to_previous_version;<br /><br /><br /><br />procedure revert_to_version<br />( p_object_name   in varchar2<br />, p_object_type   in varchar2<br />, p_object_owner  in varchar2<br />, p_version_label in varchar2<br />, p_branch        in varchar2<br />, p_seq           in number<br />, p_purge_later   in varchar2 default 'N' <br />) is<br />  l_source clob;<br />
 l_creation_time date;<br /> procedure debug<br />  ( p_txt in varchar2<br />  ) is<br />  begin<br />    dbms_output.put_line(substr(p_txt,1,255));<br />  end;<br /> begin<br />  select source<br />  ,      creation_time<br />  into   l_source<br />  ,      l_creation_time<br />  from   plsql_archive  <br />  where  object_name = p_object_name<br />  and    object_type = p_object_type<br />  and    object_owner = p_object_owner<br />  and    nvl(version_label, 'X') = nvl(p_version_label,nvl(version_label, 'X'))<br />  and    nvl(branch, nvl(p_branch,'X')) = nvl(p_branch,nvl(branch,'X'))   <br />  and    nvl(seq, 0) = nvl(p_seq,nvl(seq, 0))   <br />    ;<br />  if p_purge_later = 'Y'<br />  then <br />    -- delete last version from plsql_archive<br />    delete <br />    from  plsql_archive<br />    where object_name = p_object_name<br />    and   object_type = p_object_type<br />    and   object_owner = p_object_owner<br />    and   nvl(branch, nvl(p_branch,'X')) = nvl(p_branch,nvl(branch,'X'))   <br />    and   creation_time &gt; l_creation_time<br />	;     <br />  end if;    <br />  debug(l_source);<br />  -- create plsql object based on current source<br />  execute immediate 'create or replace '||cast( l_source as varchar2); <br />end revert_to_version;<br /><br />procedure purge<br />( p_object_name   in varchar2<br />, p_object_type   in varchar2<br />, p_object_owner  in varchar2 <br />, p_status        in varchar2 default null<br />, p_priority      in varchar2 default null<br />, p_from_datetime in date     default null<br />, p_to_datetime   in date     default null<br />, p_branch        in varchar2 default null<br />, p_seq_from      in number   default null<br />, p_seq_to        in number   default null<br />) is<br />begin<br />    delete <br />    from  plsql_archive<br />    where object_name like p_object_name<br />    and   object_type like p_object_type<br />    and   object_owner like p_object_owner<br />    and   nvl(branch, nvl(p_branch,'X')) like nvl(p_branch,nvl(branch,'X'))   <br />    and   nvl(seq, 0) between nvl(p_seq_from,nvl(seq, 0)) and nvl(p_seq_to,nvl(seq, 0))    <br />    and   creation_time between nvl(p_from_datetime,creation_time) and nvl(p_to_datetime,creation_time)<br />	and   nvl(priority, nvl(p_priority,'X')) like nvl(p_priority,nvl(priority,'X'))<br />	and   nvl(status, nvl(p_status,'X')) like nvl(p_status,nvl(status,'X'))<br />	;<br />end purge;<br /><br /><br /><br />function version_graph<br />( p_object_name   in varchar2<br />, p_object_type   in varchar2<br />, p_object_owner  in varchar2 <br />, p_show_version_label in  varchar2 default 'Y' -- show the version label <br />, p_show_seq           in  varchar2 default 'N' -- show the seq value for each version (appended to the version label if that is requested too)<br />, p_show_datetime      in  varchar2 default 'N' -- display the timestamp of the creation of each version<br />, p_show_author        in  varchar2 default 'N' -- display the author of each version<br />, p_show_labels        in  varchar2 default 'N' -- display the labels or stripes a version is associated with<br />, p_show_status        in  varchar2 default 'N' -- display the status (VALID or INVALID) of the version<br />, p_show_comments      in  varchar2 default 'N' -- display the Comments for each version<br />) return string_table<br />is<br />  l_graph string_table:= string_table('Version Graph for '||p_object_type||' '||p_object_name||' (schema '||p_object_owner||')');<br />  l_line varchar2(32000);<br />/*<br />start with the MAIN branch, then the branch who entered the version history most recently<br />MAIN   SECU          PATCH2<br />1.0                  1.0PTHC2_1.0<br />1.1     <br />        1.1SECU1.0<br />        1.1SECU1.1   1.0PTHC2_1.1<br />1.2<br />1.2(2)<br />1.2(3)                <br />*/        <br />  type branch_columns_type is table of string_table index by varchar2(32);<br />  type version_history_type is table of plsql_archive%rowtype;<br />  type branch_rec is record (branch varchar2(32), width number(4));<br />  type branches_tbl_type is table of branch_rec index by binary_integer;<br />  l_branches_tbl branches_tbl_type;<br />  l_branch_columns branch_columns_type;<br />  l_branch varchar2(32);<br />  l_vh version_history_type;<br />  idx number(5); -- index into l_vh collection<br />  ctr number(6):=1;<br />  l_next_branch varchar2(32);<br />  l_vh_done boolean:= false;<br />  l_more_on_branch boolean:= false;<br /><br />  function get_vh_tbl<br />  ( p_version in plsql_archive%rowtype<br />  , p_column_width in number default 40<br />  )  return string_table<br />  is<br />    l_return string_table:= string_table();<br />	l_comments_length number(5):= length(p_version.comments);<br />	<br />	function ifThen<br />	( p_test  in boolean<br />	, p_value in varchar2<br />	) return varchar2<br />	is<br />	begin<br />	  if p_test then return p_value; else return ''; end if;<br />	end ifThen;<br />  begin<br />	if p_show_version_label='Y' or p_show_seq='Y' or p_show_status='Y'<br />	then<br />      l_return.extend;<br />	  l_return(l_return.last):= p_version.version_label||' ('||p_version.seq||')'||ifThen(p_show_status='Y' and p_version.status ='INVALID',' *');<br />	end if;<br />	if p_show_author='Y'<br />	then<br />      l_return.extend;<br />	  l_return(l_return.last):= p_version.author;<br />	end if;<br />	if p_show_datetime='Y'<br />	then<br />      l_return.extend;<br />	  l_return(l_return.last):= to_char(p_version.creation_time,'DD-MON HH24:MI:SS');<br />	end if;<br />	if p_show_labels='Y' and length(nvl(p_version.label,''))&gt; 0<br />	then<br />      l_return.extend;<br />	  l_return(l_return.last):= 'Labels: '||p_version.label;<br />	end if;<br />	if p_show_comments='Y' and l_comments_length&gt;0<br />	then<br />	  for i in 1..trunc(l_comments_length/40)+1 loop <br />        l_return.extend;<br />	    l_return(l_return.last):= substr(p_version.comments, 1 + (i-1)*p_column_width, least(p_column_width, l_comments_length - (1 + (i-1)*p_column_width)));<br />	  end loop; <br />	end if;<br />	-- p_show_labels<br />    l_return.extend;<br />	l_return(l_return.last):= '    |';<br />    return l_return;<br />  end get_vh_tbl;<br />  procedure add<br />  ( p_string in varchar2)<br />  is<br />  begin<br />    l_graph.extend;<br />    l_graph( l_graph.last) := p_string;<br />  end add;<br />begin<br />  -- get branches  <br />  for branch in (select distinct<br />                        nvl(branch, 'MAIN') branch<br />                 ,      first_value(creation_time) over (partition by branch order by creation_time) start_branch<br />                 ,      max(length(version_label)) over (partition by branch) longest_version_label<br />                 ,      max(length(to_char(seq))) over (partition by branch) longest_seq<br />                 from   plsql_archive<br />                 order<br />                 by     start_branch<br />                ) loop<br />     l_branches_tbl(ctr).branch:= branch.branch ;<br />     l_branches_tbl(ctr).width:= greatest( 40, branch.longest_version_label+branch.longest_seq+6, length(branch.branch)+3) ;<br />     l_line:= l_line||rpad(l_branches_tbl(ctr).branch, l_branches_tbl(ctr).width, ' ');<br />     ctr:= ctr+1;                <br />  end loop; -- branch                <br />  add(l_line);  <br />  select *<br />  bulk collect into l_vh<br />  from   plsql_archive<br />  where  object_name = p_object_name<br />  and    object_type = p_object_type<br />  and    object_owner = p_object_owner <br />  order<br />  by     creation_time<br />  ;   <br /><br /> <br />  <br />  idx:= l_vh.first;<br />  l_branch_columns(nvl(l_vh(idx).branch,'MAIN')):= get_vh_tbl(l_vh(idx));<br />  loop<br />    l_line:='';<br />    -- loop over branches and for each branch column, if there is a line to write: write it!<br />        l_more_on_branch:= false;<br />	for i in 1..l_branches_tbl.count <br />	loop<br />--	  add('outside'||l_branches_tbl(i).branch); <br />	  if l_branch_columns.exists(l_branches_tbl(i).branch) and l_branch_columns(l_branches_tbl(i).branch).count &gt; 0<br />	  then<br />	-- add('inside'||l_branches_tb

l(i).branch||' count '||l_branch_columns(l_branches_tbl(i).branch).count); <br />  	  l_line:=l_line|| rpad(l_branch_columns(l_branches_tbl(i).branch)(l_branch_columns(l_branches_tbl(i).branch).first),l_branches_tbl(i).width,' ');	 <br />	  l_branch_columns(l_branches_tbl(i).branch).delete(l_branch_columns(l_branches_tbl(i).branch).first);<br />	  else<br />	    l_line:=l_line|| rpad('  ',l_branches_tbl(i).width,' ');	 <br />	  <br />	  end if;<br />	  if l_branch_columns.exists(l_branches_tbl(i).branch) and l_branch_columns(l_branches_tbl(i).branch).count &gt; 0<br />	  then<br />	    l_more_on_branch:= true;<br />	  end if;<br />	  --add('end of');<br />	end loop;<br />	add(l_line);<br />	-- if there are more versions left to process<br />	if l_vh.exists(l_vh.next(idx))<br />	then<br />  	  l_next_branch:= nvl(l_vh(l_vh.next(idx)).branch,'MAIN');<br />      -- if there is room for another branch<br />      if not l_branch_columns.exists(l_next_branch) <br />	     or l_branch_columns(l_next_branch).count = 0<br />	     or l_branch_columns( l_next_branch) is null<br />      then<br />        idx:= l_vh.next(idx);<br />        l_branch_columns(l_next_branch) := get_vh_tbl(l_vh(idx), 40); -- instead of 40 here we should indicate the width for column associated with branch l_next_branch<br />		l_more_on_branch:= true;<br />      end if;<br />	end if;<br />    ctr:=ctr+1; -- failsafe, to not run infinitely in this loop<br />    l_vh_done := l_vh.next(idx) is null;<br />    exit when l_vh_done and not l_more_on_branch;<br />    exit when ctr&gt;20000;<br />  end loop;<br />  -- now we have to go through a couple of rounds to have all branch_columns completely wash out their stacks<br />  return l_graph;<br />exception<br />when others<br />then add(sqlerrm||'ctr = '||ctr);<br />return l_graph;<br />     <br />end version_graph;<br />--<br />function get_code<br />( p_name in varchar2<br />) return clob<br />is<br />  l_code clob:='';<br />begin<br />  for src in (SELECT text FROM user_source  WHERE name=p_name ORDER BY line) loop <br />    l_code:= l_code||src.text;<br />  end loop;<br />  return l_code;<br />end get_code;<br />--<br />function get_errors<br />( p_name in varchar2<br />, p_type in varchar2<br />) return clob<br />is<br />   -- based on the example in chapter 15 of Advanced Oracle PL/SQL - Programming with packages<br />   last_line INTEGER := 0;<br />   l_errors clob:='';<br />   CURSOR err_cur <br />   IS<br />      SELECT line, text<br />        FROM user_errors <br />       WHERE name = UPPER (p_name)<br />         AND type = UPPER (p_type)<br />       ORDER BY line;<br />   /* Local Modules */   <br />   procedure add<br />   ( p_text in varchar2<br />   ) is<br />   begin<br />     l_errors:= l_errors||p_text;<br />   end add;<br />   PROCEDURE err_put_line <br />      (prefix_in IN VARCHAR2, text_in IN VARCHAR2)<br />   IS<br />   BEGIN<br />      add<br />         (RTRIM (RPAD (prefix_in, 8) || text_in, CHR(10)));<br />   END;<br />   --<br />   PROCEDURE display_line (line_in IN INTEGER)<br />   IS<br />      CURSOR src_cur<br />      IS<br />        SELECT S.line, S.text<br />          FROM user_source S<br />         WHERE S.name = UPPER (p_name)<br />           AND S.type = UPPER (p_type)<br />           AND S.line = line_in;<br />      src_rec src_cur%ROWTYPE;<br />   BEGIN<br />     OPEN src_cur;<br />     FETCH src_cur INTO src_rec;<br />     IF src_cur%FOUND<br />     THEN<br />        err_put_line (TO_CHAR (line_in), src_rec.text);<br />     END IF;<br />     CLOSE src_cur;<br />   END;<br />   --<br />   PROCEDURE display_err (line_in IN INTEGER)<br />   IS<br />      CURSOR err_cur<br />      IS<br />        SELECT line, position, text<br />          FROM user_errors<br />         WHERE name = UPPER (p_name)<br />           AND type = UPPER (p_type)<br />           AND line = line_in;<br />      err_rec err_cur%ROWTYPE;<br />   BEGIN<br />     OPEN err_cur;<br />     FETCH err_cur INTO err_rec;<br />     IF err_cur%FOUND<br />     THEN<br />        add ('ERR' || LPAD ('*', err_rec.position+5));<br />        err_put_line ('ERR', err_rec.text);<br />     END IF;<br />     CLOSE err_cur;<br />   END;<br />  --<br />BEGIN<br />   /* Main body of procedure. Loop through all error lines. */<br />   FOR err_rec IN err_cur<br />   LOOP<br />      /* Show the surrounding code. */<br />      FOR line_ind IN err_rec.line-2 .. err_rec.line+2<br />      LOOP<br />         IF last_line &lt; line_ind<br />         THEN<br />            display_line (line_ind);<br />            display_err (line_ind);<br />         END IF;<br />         last_line := GREATEST (last_line, line_ind);<br />      END LOOP;<br />   END LOOP;<br />   dbms_output.put_line(substr(l_errors,1,255));<br />   return l_errors;<br />END get_errors;<br />--<br />end plsql_archiver;<br />/<br />