Package example

doc/sql.extensions/README.packages.txt

@@ -121,5 +121,4 @@ Notes:
     - UDFs (DECLARE EXTERNAL FUNCTION) are currently not supported inside packages.
 
 Examples:
-    - To come.
+    - See examples/package.
-

examples/package/fbout-body.sql

@@ -0,0 +1,84 @@
+/*
+ *  The contents of this file are subject to the Initial
+ *  Developer's Public License Version 1.0 (the "License");
+ *  you may not use this file except in compliance with the
+ *  License. You may obtain a copy of the License at
+ *  http://www.ibphoenix.com/main.nfs?a=ibphoenix&page=ibp_idpl.
+ *
+ *  Software distributed under the License is distributed AS IS,
+ *  WITHOUT WARRANTY OF ANY KIND, either express or implied.
+ *  See the License for the specific language governing rights
+ *  and limitations under the License.
+ *
+ *  The Original Code was created by Adriano dos Santos Fernandes
+ *  for the Firebird Open Source RDBMS project.
+ *
+ *  Copyright (c) 2009 Adriano dos Santos Fernandes <adrianosf@gmail.com>
+ *  and all contributors signed below.
+ *
+ *  All Rights Reserved.
+ *  Contributor(s): ______________________________________.
+ */
+
+set term !;
+
+
+recreate package body fb$out
+as
+begin
+	procedure enable
+	as
+	begin
+		rdb$set_context('USER_SESSION', 'fb$out.enabled', '1');
+	end;
+
+	procedure disable
+	as
+	begin
+		rdb$set_context('USER_SESSION', 'fb$out.enabled', null);
+	end;
+
+	procedure put_line (line fb$out_type)
+	as
+	begin
+		if (rdb$get_context('USER_SESSION', 'fb$out.enabled') = '1') then
+		begin
+			in autonomous transaction do
+			begin
+				insert into fb$out_table (line_num, content)
+					values (next value for fb$out_seq, :line);
+			end
+		end
+	end;
+
+	procedure clear
+	as
+	begin
+		in autonomous transaction do
+			delete from fb$out_table;
+	end;
+
+	procedure get_lines returns (lines fb$out_type)
+	as
+		declare line fb$out_type;
+	begin
+		lines = '';
+
+		in autonomous transaction do
+		begin
+			for select content from fb$out_table order by line_num into line
+			do
+			begin
+				if (octet_length(lines) > 0) then
+					lines = lines || ascii_char(13) || ascii_char(10);
+
+				lines = lines || :line;
+			end
+		end
+
+		execute procedure clear;
+	end;
+end!
+
+
+set term ;!

examples/package/fbout-header.sql

@@ -0,0 +1,54 @@
+/*
+ *  The contents of this file are subject to the Initial
+ *  Developer's Public License Version 1.0 (the "License");
+ *  you may not use this file except in compliance with the
+ *  License. You may obtain a copy of the License at
+ *  http://www.ibphoenix.com/main.nfs?a=ibphoenix&page=ibp_idpl.
+ *
+ *  Software distributed under the License is distributed AS IS,
+ *  WITHOUT WARRANTY OF ANY KIND, either express or implied.
+ *  See the License for the specific language governing rights
+ *  and limitations under the License.
+ *
+ *  The Original Code was created by Adriano dos Santos Fernandes
+ *  for the Firebird Open Source RDBMS project.
+ *
+ *  Copyright (c) 2009 Adriano dos Santos Fernandes <adrianosf@gmail.com>
+ *  and all contributors signed below.
+ *
+ *  All Rights Reserved.
+ *  Contributor(s): ______________________________________.
+ */
+
+create sequence fb$out_seq;
+
+create domain fb$out_type as blob sub_type text character set utf8 not null;
+
+create global temporary table fb$out_table (
+	line_num int,  
+	content fb$out_type
+) on commit preserve rows;
+
+
+set term !;
+
+
+create or alter package fb$out
+as
+begin
+	procedure enable;
+	procedure disable;
+
+	procedure put_line (line fb$out_type);
+	procedure clear;
+
+	procedure get_lines returns (lines fb$out_type);
+end!
+
+
+set term ;!
+
+
+grant all on table fb$out_table to package fb$out;
+
+grant execute on package fb$out to public;

examples/package/fbout-test.sql

@@ -0,0 +1,67 @@
+/*
+ *  The contents of this file are subject to the Initial
+ *  Developer's Public License Version 1.0 (the "License");
+ *  you may not use this file except in compliance with the
+ *  License. You may obtain a copy of the License at
+ *  http://www.ibphoenix.com/main.nfs?a=ibphoenix&page=ibp_idpl.
+ *
+ *  Software distributed under the License is distributed AS IS,
+ *  WITHOUT WARRANTY OF ANY KIND, either express or implied.
+ *  See the License for the specific language governing rights
+ *  and limitations under the License.
+ *
+ *  The Original Code was created by Adriano dos Santos Fernandes
+ *  for the Firebird Open Source RDBMS project.
+ *
+ *  Copyright (c) 2009 Adriano dos Santos Fernandes <adrianosf@gmail.com>
+ *  and all contributors signed below.
+ *
+ *  All Rights Reserved.
+ *  Contributor(s): ______________________________________.
+ */
+
+/*
+ * This example demonstrate packages creating and using FB$OUT, a package that write and read
+ * messages in a session and is suitable for debug PSQL code.
+ */
+
+set names utf8;
+
+create database 'test.fdb';
+
+input 'fbout-header.sql';
+input 'fbout-body.sql';
+
+set term !;
+
+create procedure test
+as
+	declare i integer;
+begin
+	execute procedure fb$out.put_line ('um');
+	execute procedure fb$out.put_line ('dois');
+	execute procedure fb$out.enable;
+	execute procedure fb$out.put_line ('três');
+	execute procedure fb$out.put_line ('quatro');
+	execute procedure fb$out.disable;
+	execute procedure fb$out.put_line ('cinco');
+	execute procedure fb$out.enable;
+	execute procedure fb$out.put_line ('seis');
+	begin
+		i = 'a';
+		execute procedure fb$out.put_line ('sete');
+	when any do
+		begin
+		end
+	end
+end!
+
+set term ;!
+
+grant execute on procedure test to public;
+
+
+execute procedure test;
+
+execute procedure fb$out.get_lines;
+execute procedure fb$out.get_lines;