NEW CONTEST: Useful and Cool Stored Procedures
IBSurgeon
Are you true master in Firebird SQL? Participate in Stored Procedures
contest and win valuable prizes!
Participants should submit stored procedure in pure Firebid SQL and
embedded functions (SDF) only which performs some common task(s) -
virtually anything any useful tasks.
It can be implementations of some mathematics transformations, or
transforming numeric representation of number into words (like input =
21, output = "twenty one"), or anything that demonstrates the power
and flexibility of Firebird stored procedures.
We'll choose the most powerful and interesting stored procedures.
There will be 3 winners, each of them will receive tool by his choice
from the pool of prizes from MindTheBird sponsors:
http://www.mindthebird.com/benefits.html.
All procedures should be submited under Creative Commons or Mozilla
Public License or Apache License. Submitter must be the author of the
procedure.
All procedures with short description and reference to the author will
be published at www.mindthebird.com
Please submit demo SQL scripts with stored procedures' texts to sp at
mindthebird.com or right here in the group. Please notice that demo
SQL script should work out-of-the-box to create necessary objects and
demonstrate the value of procedure.
Željko Cvijanović
Where do I provide a function "LatinToCir" (translation of Latin into Cyrillic) and "letters" (value brojacanu write letters) source code in pascal - Delphi
Teslić - Republika Srpska BiH
http://sites.google.com/site/zeljusorg/
--
To unsubscribe, reply using "remove me" as the subject.
Carlos H. Cantu
Carlos
IBSurgeon
His procedure #1 transforms BLOB filled with comma-separated numerics
into the recordset.
SET TERM ^ ;
create or alter procedure LIST_TO_ROWS (
LST blob sub_type 1 segment size 80)
returns (
ID integer)
AS
declare pos_ int;
declare offset int = 1;
declare beg int;
declare buf varchar(30100);
begin
while (0=0) do begin
buf = substring(lst from offset for 30100);
pos_ = 1; beg = 1;
while (pos_ <= char_length(buf) and pos_ <= 30000) do begin
if (substring(buf from pos_ for 1) = ',') then begin
if (pos_ > beg) then
id = substring(buf from beg for pos_ - beg);
else
id = null;
suspend;
beg = pos_ + 1;
end
pos_ = pos_ + 1;
end
if (offset + pos_ - 2 = char_length(lst)) then leave;
offset = offset + beg - 1;
if (offset > char_length(lst)) then leave;
end
if (pos_ > beg) then
id = substring(buf from beg for pos_ - beg);
else
id = null;
suspend;
end^
SET TERM ; ^
The second procedure transforms numeric currency value into Russian
written representation of the numeric:
SET TERM ^ ;
create or alter procedure CURRENCYSTR (
VAL numeric(15,2),
SHOWCURRENCY integer)
returns (
CURR_STR varchar(1000))
AS
declare razryad varchar(50);
declare razryad_idx varchar(28);
declare hundreds varchar(64);
declare hundreds_idx varchar(30);
declare tens varchar(69);
declare tens_idx varchar(40);
declare ones varchar(138);
declare ones_idx varchar(100);
declare sign_of_val varchar(6);
declare raz int;
declare cents varchar(3);
declare val_str varchar(20);
declare num varchar(20);
declare i int;
declare buf varchar(200);
declare buf1 varchar(200);
begin
/* Константы */
razryad_idx = /* 2.2 */ '010001050607130821082911';
razryad = 'тысячмиллионмиллиардтриллионквадриллион';
hundreds_idx = /* 2.1 */ '010013046106169257328407479569';
hundreds =
'стодвеститристачетырестапятьсотшестьсотсемьсотвосемьсотдевятьсот';
tens_idx = /* 2.2 */ '0100010001080908170522093110410950116109';
tens =
'двадцатьтридцатьсорокпятьдесятшестьдесятсемьдесятвосемьдесятдевяносто';
ones_idx = /* 3.2 */
'0010000100001000010300406010040140501904023060290603506041110521006210072120841009411105101151212712';
ones =
'тричетырепятьшестьсемьвосемьдевятьдесятьодиннадцатьдвенадцатьтринадцатьчетырнадцатьпятнадцатьшестнадцатьсемнадцатьвосемнадцатьдевятнадцать';
if (ShowCurrency is null) then ShowCurrency = 0;
curr_str = '';
/* Смотрим знак */
if (val < 0) then begin
sign_of_val = 'минус ';
val = -val;
end else
sign_of_val = '';
/* Выбираем и запоминаем копейки, убираем их из числа */
val_str = cast(val as varchar(20));
i = position('.' in val_str);
cents = lpad(substring(val_str from i+1 for 2), 2, '0');
val_str = lpad(substring(val_str from 1 for i-1), (trunc((i+1)/
3)*3), '0');
/* Разбираем число */
raz = 0; curr_str = '';
while (val_str != '') do begin
/* Берём триаду символов */
num = right(val_str, 3);
/* Если не нулевое число */
if (num != '000') then begin
/* Берём сотни */
i = cast(substring(num from 1 for 1) as int);
buf = substring(hundreds from cast(substring(hundreds_idx from
i*3+1 for 2) as int) for cast(substring(hundreds_idx from i*3+3 for 1)
as int));
/* Далее десятки */
/* Для "десятнадцатых" упрощённая обработка */
if (substring(num from 2 for 1) = '1') then begin
/* Вставляем нужную "десятнадцать" */
i = cast(substring(num from 2 for 2) as int);
buf1 = substring(ones from cast(substring(ones_idx from
i*5+1 for 3) as int) for cast(substring(ones_idx from i*5+4 for 2) as
int));
if (buf != '') then buf = buf || ' ';
buf = buf || buf1;
end else
/* Для "нормальных" чисел своя обработка */
begin
/* Десятки */
i = cast(substring(num from 2 for 1) as int);
buf1 = substring(tens from cast(substring(tens_idx from i*4+1
for 2) as int) for cast(substring(tens_idx from i*4+3 for 2) as int));
if (buf != '' and buf1 != '') then buf = buf || ' ';
buf = buf || buf1;
/* Единицы */
i = cast(substring(num from 3 for 1) as int);
/* Смотрим количество для нужного окончания */
if (i = 1) then begin
if (raz = 1) then buf1 = 'одна'; else buf1 = 'один';
end else
if (i = 2) then begin
if (raz = 1) then buf1 = 'две'; else buf1 = 'два';
end else
buf1 = substring(ones from cast(substring(ones_idx from
i*5+1 for 3) as int) for cast(substring(ones_idx from i*5+4 for 2) as
int));
if (buf != '' and buf1 != '') then buf = buf || ' ';
buf = buf || buf1;
end
/* Разряд числа */
buf1 = substring(razryad from cast(substring(razryad_idx from
raz*4+1 for 2) as int) for cast(substring(razryad_idx from raz*4+3 for
2) as int));
if (buf1 != '') then begin
/* Подбор окончания для разряда */
if (i = 1) then begin
if (raz = 1) then buf1 = buf1 || 'а';
end else
if (i in (2,3,4)) then begin
if (raz = 1) then buf1 = buf1 || 'и';
else if (raz > 1) then buf1 = buf1 || 'а';
end else
if (raz > 1) then buf1 = buf1 || 'ов';
buf = buf || ' ' || buf1;
end
end else
buf = '';
/* Присоединяем обработанную триаду к результату */
if (curr_str != '' and buf != '') then buf = buf || ' ';
curr_str = buf || curr_str;
/* Переходим к следующей триаде */
val_str = left(val_str, char_length(val_str)-3);
/* Увеличиваем счётчик разряда */
raz = raz + 1;
end
/* Припысываем знак */
curr_str = sign_of_val || curr_str;
/* Делаем первую букву прописной */
curr_str = upper(substring(curr_str from 1 for 1)) ||
substring(curr_str from 2);
/* Флаг "показать название валюты" */
if (ShowCurrency = 1) then
curr_str = curr_str || ' руб. ' || cents || ' коп.';
suspend;
end^
SET TERM ; ^
Carlos H. Cantu
Carlos
Carlos H. Cantu
Codebue Fabio - P-Soft
Hi,
I just sent another mail to mine 400 users of italian community with stored procedure and article contest
PS benefits page of mindthebird.com have an error:
particpants --> partecipants
Codebue Fabio
.--------------------------------.
P-Soft di Codebue Fabio
via Nuova, 9
24060 Tavernola B.sca - BG
Web : www.p-soft.biz
EMail: f.co...@p-soft.biz
Željko Cvijanović
Milan Babuskov
> Firebird 1.5
Hi Zeljko,
I like you procedure, it is usable, but it would be nice if you used
Firebird 2.5 because this campaign is about promoting it.
> ----------------------------------------------------------
> external function:
> DECLARE EXTERNAL FUNCTION mod
> INTEGER, INTEGER
> RETURNS DOUBLE PRECISION BY VALUE
> ENTRY_POINT 'IB_UDF_mod' MODULE_NAME 'ib_udf';
>
> DECLARE EXTERNAL FUNCTION substr
> CSTRING(255), SMALLINT, SMALLINT
> RETURNS CSTRING(255) FREE_IT
> ENTRY_POINT 'IB_UDF_substr' MODULE_NAME 'ib_udf';
MOD is internal function in Firebird 2.x, so no need to declare.
Instead of SUBSTR, you can use built-in SUBSTRING which is
multi-byte-character aware.
Also, a description for procedure would be nice, for those who don't
know what is JMBG.
--
Milan Babuskov
http://www.flamerobin.org
Željko Cvijanović
Željko Cvijanović
Željko Cvijanović
Milan Babuskov
2010/4/2 Željko Cvijanović <cvze...@gmail.com>:
> add table "sSlovima"
> INSERT INTO "sSlovima" ("SlovimaID", "Slovima") VALUES ( '47', 'milijarda');
> INSERT INTO "sSlovima" ("SlovimaID", "Slovima") VALUES ( '48', 'milijardi');
> INSERT INTO "sSlovima" ("SlovimaID", "Slovima") VALUES ( '49', 'bilijun');
> INSERT INTO "sSlovima" ("SlovimaID", "Slovima") VALUES ( '50', 'bilijuna');
> INSERT INTO "sSlovima" ("SlovimaID", "Slovima") VALUES ( '54', 'milijarde');
This is really cool. Did you consider to also add an English version
(just using different INSERTs)?
Željko Cvijanović
a translation using Google Translator
(just using different INSERTs)?
IBSurgeon
operations (comments are in English and in Russian):
/*
Decimal long-string arithmetic procedures. Decimal point is allowed,
signs (+/-) are not allowed.
Useful thing for study and reminiscences, not for production
releases.
You may use this code without any restrictions, but you must mention
me.
MindTheBird - and mind pizmon too.
Процедуры десятичной длинностроковой точной арифметики разработаны
в исторически-юмористически-дидактических целях. Поддерживается
десятичная точка, не поддерживаются знаки (+/-).
Автор подозревает о существовании ряда полезных нововведений,
позволяющих "этим вот" больше не заниматься. Но автор обращает
внимание благосклонной аудитории на следующее:
1. Как не хватало нам этих полезных нововведений в те далекие
годы, когда
Firebird был Interbase, а ОС Novell Netware была тем, чем она
была! И
ничего, почти все выжили.
2. Умение, как говорил шахматист Остап Бендер, "с ничтожными
силами овладеть
всей доской" стимулирет интеллектуальную смелость, необходимую
для профессии программиста. Изучать древний опыт также
полезно.
"Чтобы стоять, я должен держаться корней".
Допускается любое использование этих процедур при упоминании автора.
(с) pizmon
*/
set term ^;
/*
this extracts from string "s" a digit defined by template "templ".
Nowadays we've got "substring" to do it without kinking our brain.
эта процедура вычленяет из строки s разряд, определяемый шаблоном
templ.
для этого в наше время используется substring.
*/
create procedure dig
(
s varchar(1000),
templ varchar(1000)
)
returns
(
result integer
)
as
begin
if (s like '%' || '0' || templ) then
result = 0;
else if (s like '%' || '1' || templ) then
result = 1;
else if (s like '%' || '2' || templ) then
result = 2;
else if (s like '%' || '3' || templ) then
result = 3;
else if (s like '%' || '4' || templ) then
result = 4;
else if (s like '%' || '5' || templ) then
result = 5;
else if (s like '%' || '6' || templ) then
result = 6;
else if (s like '%' || '7' || templ) then
result = 7;
else if (s like '%' || '8' || templ) then
result = 8;
else if (s like '%' || '9' || templ) then
result = 9;
else if (s like '%' || '.' || templ) then
result = -1;
else
result = null;
suspend;
end
^
/*
this divides string "s" by ten shifting decimal point.
эта процедура делит строку s на 10 методом сдвига десятичной точки.
*/
create procedure strshift
(
s varchar(1000)
)
returns
(
result varchar(1000)
)
as
declare variable templ varchar(1000);
declare variable d integer;
declare variable n integer;
begin
templ = '';
result = '';
if (s not like '%.%') then
n = 1;
else
n = 0;
while (1=1) do
begin
select result from dig(:s, :templ) into :d;
if (d is null) then
begin
if (result like '.%') then
result = '0' || result;
suspend;
exit;
end
else if (d = -1) then
n = 1;
else
begin
result = d || result;
if (n = 1) then
begin
result = '.' || result;
n = 0;
end
end
templ = templ || '_';
end
end
^
/*
this reconciles strings "s1" and "s2" to make them agree with
decimal point
position.
эта процедура приводит строки s1 и s2 к виду, в котором десятичная
точка
стоит в одном и том же разряде
*/
create procedure strnormalize
(
s1 varchar(1000),
s2 varchar(1000)
)
returns
(
result1 varchar(1000),
result2 varchar(1000)
)
as
declare variable templ1 varchar(1000);
declare variable n1 integer;
declare variable templ2 varchar(1000);
declare variable n2 integer;
begin
templ1 = '';
n1 = 0;
if (s1 like '%.%') then
while (s1 not like '%.' || templ1) do
begin
templ1 = templ1 || '_';
n1 = n1 + 1;
end
templ2 = '';
n2 = 0;
if (s2 like '%.%') then
while (s2 not like '%.' || templ2) do
begin
templ2 = templ2 || '_';
n2 = n2 + 1;
end
result1 = s1;
result2 = s2;
while (n1 > n2) do
begin
if (n2 = 0) then
result2 = result2 || '.';
result2 = result2 || '0';
n2 = n2 + 1;
end
while (n2 > n1) do
begin
if (n1 = 0) then
result1 = result1 || '.';
result1 = result1 || '0';
n1 = n1 + 1;
end
suspend;
end
^
/*
this adds string "s1" to string "s2" using old-school "column"
method.
эта процедура складывет строки s1 и s2 "в столбик".
*/
create procedure stradd
(
s1 varchar(1000),
s2 varchar(1000)
)
returns
(
result varchar(1000)
)
as
declare variable templ varchar(1000);
declare variable carry integer;
declare variable d1 integer;
declare variable d2 integer;
begin
select result1, result2 from strnormalize(:s1, :s2) into :s1, :s2;
templ = '';
result = '';
carry = 0;
while (1=1) do
begin
select result from dig(:s1, :templ) into :d1;
select result from dig(:s2, :templ) into :d2;
if (d1 is null and d2 is null) then
begin
if (carry <> 0) then
result = carry || result;
suspend;
exit;
end
else
begin
if (d1 = -1 or d2 = -1) then
result = '.' || result;
else
begin
if (d1 is not null) then
carry = carry + d1;
if (d2 is not null) then
carry = carry + d2;
result = (carry - (carry / 10) * 10) || result;
carry = carry / 10;
end
end
templ = templ || '_';
end
end
^
/*
this multiplies string "s" by "dig" using repeated additions.
эта процедура умножает строку s на целое число dig многократным
сложением
*/
create procedure strdigmul
(
s varchar(1000),
dig integer
)
returns
(
result varchar(1000)
)
as
begin
result = '0';
while (dig > 0) do
begin
select result from stradd(:result, :s) into :result;
dig = dig - 1;
end
suspend;
end
^
/*
this subtracts string "s2" from string "s1" using old-school
"column" method.
эта процедура вычитает строку s2 из строки s1 "в столбик".
*/
create procedure strsub
(
s1 varchar(1000),
s2 varchar(1000)
)
returns
(
result varchar(1000)
)
as
declare variable templ varchar(1000);
declare variable carry integer;
declare variable n integer;
declare variable d1 integer;
declare variable d2 integer;
begin
select result1, result2 from strnormalize(:s1, :s2) into :s1, :s2;
templ = '';
result = '';
carry = 0;
while (1=1) do
begin
select result from dig(:s1, :templ) into :d1;
select result from dig(:s2, :templ) into :d2;
if (d1 is null and d2 is null) then
begin
suspend;
exit;
end
else
begin
if (d1 = -1 or d2 = -1) then
result = '.' || result;
else
begin
if (d1 is not null) then
carry = carry + d1;
if (d2 is not null) then
carry = carry - d2;
n = 0;
while (carry < 0) do
begin
n = n + 1;
carry = carry + 10;
end
result = (carry - (carry / 10) * 10) || result;
carry = (carry / 10) - n;
end
end
templ = templ || '_';
end
end
^
/*
this multiplies string "s1" by "s2" using old-school "column"
method.
эта процедура умножает строку s1 на строку s2 "в столбик".
*/
create procedure strmul
(
s1 varchar(1000),
s2 varchar(1000)
)
returns
(
result varchar(1000)
)
as
declare variable n integer;
declare variable d2 integer;
declare variable templ varchar(1000);
declare variable frac varchar(1000);
declare variable mul varchar(1000);
begin
templ = '';
frac = '0';
n = 0;
result = '0';
mul = s1;
while (1=1) do
begin
select result from dig(:s2, :templ) into :d2;
if (d2 is null) then
begin
select result from stradd(:frac, :result) into :result;
suspend;
exit;
end
if (d2 <> -1) then
begin
select result from stradd((select result from
strdigmul(:mul, :d2)), :result) into :result;
select result from strdigmul(:mul, 10) into :mul;
n = n + 1;
end
else
begin
frac = result;
while (n > 0) do
begin
select result from strshift(:frac) into :frac;
n = n - 1;
end
result = '0';
mul = s1;
end
templ = templ || '_';
end
end
^
/*
this compares strings "s1" and "s2". Unsignificant zeroes are
allowed.
эта процедура сравнивает строку s1 со строкой s2. Обрабатываются
ситуации лидирующих/завершающих нулей
*/
create procedure strcomp
(
s1 varchar(1000),
s2 varchar(1000)
)
returns
(
result integer
)
as
declare variable templ varchar(1000);
declare variable l1 integer;
declare variable l2 integer;
begin
select result1, result2 from strnormalize(:s1, :s2) into :s1, :s2;
if (s1 = s2) then
result = 0;
else
begin
l1 = 0;
templ = '';
while (s1 not like templ) do
begin
templ = templ || '_';
l1 = l1 + 1;
end
l2 = 0;
templ = '';
while (s2 not like templ) do
begin
templ = templ || '_';
l2 = l2 + 1;
end
while (l1 < l2) do
begin
s1 = '0' || s1;
l1 = l1 + 1;
end
while (l2 < l1) do
begin
s2 = '0' || s2;
l2 = l2 + 1;
end
if (s1 = s2) then
result = 0;
else if (s1 < s2) then
result = -1;
else
result = 1;
end
suspend;
end
^
/*
this calculates factorial of string "s"
эта процедура возвращает факториал строки s
*/
create procedure strfactorial
(
s varchar(1000)
)
returns
(
result varchar(1000)
)
as
declare variable cmp integer;
begin
result = s;
while (1=1) do
begin
select result from strcomp(:s, '1') into :cmp;
if (cmp = 0) then
begin
suspend;
exit;
end
else
begin
select result from strsub(:s, '1') into :s;
select result from strmul(:result, :s) into :result;
end
end
end
^
/*
this raises string "s" to "dig" power using repeated
multiplications.
эта процедура возводит строку s в целочисленную степень методом
многокоратного умножения.
*/
create procedure strdigpwr
(
s varchar(1000),
dig integer
)
returns
(
result varchar(1000)
)
as
begin
result = '1';
while (dig > 0) do
begin
select result from strmul(:result, :s) into :result;
dig = dig - 1;
end
suspend;
end
^
/*
this divides string "s1 " by string "s2". "Maxdigits" limits amount
of
decimal digits in resulting periodical fraction (if any).
эта процедура делит строку s1 на строку s2. Параметр maxdigits
ограничивает количество знаков в случае,
если результатом деления является периодическая десятичная дробь.
*/
create procedure strdiv
(
s1 varchar(1000),
s2 varchar(1000),
maxdigits integer
)
returns
(
result varchar(1000)
)
as
declare variable n integer;
declare variable cmp integer;
declare variable m integer;
declare variable att varchar(1000);
declare variable d integer;
declare variable len integer;
declare variable cond integer;
declare variable divisor varchar(1000);
begin
divisor = s2;
n = 0;
cmp = 1;
m = 1;
while (cmp > 0) do
begin
select result from strcomp(:s1, :s2) into :cmp;
if (cmp > 0) then
begin
select result from strdigmul(:s2, 10) into :s2;
n = n + 1;
m = m * 10;
end
else if (cmp = 0) then
begin
result = m;
suspend;
exit;
end
end
select result from strshift(:s2) into :s2;
result = '';
cmp = 1;
len = 0;
while (1=1) do
begin
len = len + 1;
if (len = maxdigits) then
begin
suspend;
exit;
end
if (len = n + 1) then
begin
if (result = '') then
result = '0';
result = result || '.';
end
d = 9;
while (d >= 0) do
begin
select result from strdigmul(:s2, :d) into :att;
select result from strcomp(:s1, :att) into :cmp;
if (cmp < 0) then
d = d - 1;
else
begin
select result from strsub(:s1, :att) into :s1;
select result from strcomp(:s2, :divisor) into :cond;
result = result || d;
d = -1;
if (cmp = 0 and cond = 0) then
begin
suspend;
exit;
end
select result from strshift(:s2) into :s2;
end
end
end
end
^
/*
ladies and gentelmen! Now here the exponent! An exponent is
calulated using
Taylor series.
Барабанная дробь: то, ради чего всё затевалось. Экспонента
рассчитывается по ряду Тейлора.
*/
create procedure strexp
(
s varchar(1000),
maxdigits integer,
members integer
)
returns
(
result varchar(1000)
)
as
declare variable n integer;
declare variable p varchar(1000);
declare variable f varchar(1000);
begin
p = '1';
f = '1';
n = 0;
result = '1';
while (n < members) do
begin
n = n + 1;
select result from strmul(:p, :s) into :p;
select result from strdigmul(:f, :n) into :f;
select result from stradd(:result, (select result from
strdiv(:p, :f, :maxdigits))) into :result;
end
suspend;
end
^
/*
we have to test it!
неужели мы это не проверим?
*/
select result from strexp('1', 10, 20)
/*
The result is 2.718281823. Real value is e=2.718281828, we've got
an
error in last digit. Not bad, yeah?
Exponent opens a door to high math for us, but it is about math,
not about Firebird.
Thank you.
результат: 2.718281823
насколько я помню, e=2.718281828, то есть ошибка в последнем знаке.
Неплохо, ведь правда?
Имея на руках экспоненту положительных чисел, перед нами открыты все
двери.
Дальнейшее имеет отношение к учебнику математики за седьмой класс,
но, увы,
уже не имеет никакого отношения к Firebird.
Спасибо за внимание.
*/
^
set term ;^