print 'Copyright © 1995, 2008, Oracle Corporation.  All Rights Reserved.';
print ' ';

-- Copyright © 1995, 2008, Oracle Corporation. All Rights Reserved.
-- "This script defines functions that use the Rdb$ORACLE_SQLFUNC_VCHAR_DOM"
-- "character domain for character types and the Rdb$ORACLE_SQLFUNC_DATE_DOM"
-- "date domain for date types. This script attempts to create the"
-- "Rdb$ORACLE_SQLFUNC_VCHAR_DOM domain as VARCHAR(2000) using the default"
-- "character set and the Rdb$ORACLE_SQLFUNC_DATE_DOM domain as DATE VMS."
-- "You can override these settings by defining these domains with the settings of"
-- "your choice. Then either ROLLBACK or run the SQL_FUNCTIONS_DROP72.SQL script"
-- "as appropriate. Finally, re-run this script and ignore the 2 error messages"
-- "that result when this script attempts to create the 2 domains."
-- "If the character set is not DEC_MCS, you must establish the character set"
-- "properly before running this script."
--
declare :Rdb_CHARACTER_LENGTH_MODE char(31);
declare :Rdb_DIALECT char(31);
declare :Rdb_QUOTING char(31);

-- save some session information
get environment (session)
    :Rdb_QUOTING = QUOTING_RULES;
set quoting rules 'SQL92';
get environment (session)
    :Rdb_CHARACTER_LENGTH_MODE = "CHARACTER_LENGTH",
    :Rdb_DIALECT = "DIALECT";

set dialect 'SQLV40';
set warning nodeprecate;
create procedure RDB$ORACLE_SQLFUNC_INTRO();
external
name RDB$ORACLE_SQLFUNC_INTRO
location 'SQL$FUNCTIONS'
with all logical_name translation
language C
parameter style GENERAL
comment is 'For Oracle internal use only.';
begin call RDB$ORACLE_SQLFUNC_INTRO(); end;
drop procedure RDB$ORACLE_SQLFUNC_INTRO;

set character length 'CHARACTER';

create domain Rdb$ORACLE_SQLFUNC_VCHAR_DOM varchar(2000);
create domain Rdb$ORACLE_SQLFUNC_DATE_DOM date vms;
create domain Rdb$ORACLE_SQLFUNC_DEC_MCS_DOM char(1) character set dec_mcs;
create domain Rdb$ORACLE_SQLFUNC_CHAR_DOM char(1);

-- External functions:

-- Rdb SQL functions fashioned after Oracle SQL functions:
-- Number functions:
PRINT ' Creating ABS ';
CREATE FUNCTION ABS (in DOUBLE PRECISION by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_ABS
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns the absolute value of N. ';
GRANT EXECUTE ON FUNCTION ABS TO PUBLIC;

PRINT ' Creating CEIL ';
CREATE FUNCTION CEIL (in DOUBLE PRECISION by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_CEIL
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns the smallest integer greater than or equal to N. ';
GRANT EXECUTE ON FUNCTION CEIL TO PUBLIC;

PRINT ' Creating ACOS ';
CREATE FUNCTION ACOS (in DOUBLE PRECISION by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_ACOS
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns the arc cosine of N (an angle expressed in radians). ';
GRANT EXECUTE ON FUNCTION ACOS TO PUBLIC;

PRINT ' Creating ACOSH ';
CREATE FUNCTION ACOSH (in DOUBLE PRECISION by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_ACOSH
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns the hyperbolic arc cosine of its argument. ';
GRANT EXECUTE ON FUNCTION ACOSH TO PUBLIC;

PRINT ' Creating COS ';
CREATE FUNCTION COS (in DOUBLE PRECISION by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_COS
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns the cosine of N (an angle expressed in radians). ';
GRANT EXECUTE ON FUNCTION COS TO PUBLIC;

PRINT ' Creating COT ';
CREATE FUNCTION COT (in DOUBLE PRECISION by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_COT
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns the cotangent of its radian argument. ';
GRANT EXECUTE ON FUNCTION COT TO PUBLIC;

PRINT ' Creating COSH ';
CREATE FUNCTION COSH (in DOUBLE PRECISION by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_COSH
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns the hyperbolic cosine of N (an angle expressed in radians). ';
GRANT EXECUTE ON FUNCTION COSH TO PUBLIC;

PRINT ' Creating EXP ';
CREATE FUNCTION EXP (in DOUBLE PRECISION by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_EXP
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns e raised to the Nth power (e = 2.71828183...). ';
GRANT EXECUTE ON FUNCTION EXP TO PUBLIC;

PRINT ' Creating FLOOR ';
CREATE FUNCTION FLOOR (in DOUBLE PRECISION by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_FLOOR
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns the largest integer equal to or less than N. ';
GRANT EXECUTE ON FUNCTION FLOOR TO PUBLIC;

PRINT ' Creating LN ';
CREATE FUNCTION LN (in DOUBLE PRECISION by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_LN
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns the natural logarithm of N where N is greater than 0. ';
GRANT EXECUTE ON FUNCTION LN TO PUBLIC;

PRINT ' Creating LOG ';
CREATE FUNCTION LOG (in DOUBLE PRECISION by reference, in DOUBLE PRECISION by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_LOG
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns the logarithm base M of N. The base M can be any positive -
 number other than 0 or 1 and N can be any positive number. ';
GRANT EXECUTE ON FUNCTION LOG TO PUBLIC;

PRINT ' Creating MOD ';
CREATE FUNCTION MOD (in DOUBLE PRECISION by reference, in DOUBLE PRECISION by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_MOD
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns the remainder of M divided by N. Returns M if N is 0. ';
GRANT EXECUTE ON FUNCTION MOD TO PUBLIC;

PRINT ' Creating POWER ';
CREATE FUNCTION POWER (in DOUBLE PRECISION by reference, in DOUBLE PRECISION by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_POWER
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns M raised to the Nth power. The base M and the exponent N can -
 be any numbers but if M is negative N must be an integer. ';
GRANT EXECUTE ON FUNCTION POWER TO PUBLIC;

PRINT ' Creating ROUND ';
CREATE FUNCTION ROUND (in DOUBLE PRECISION by reference, in DOUBLE PRECISION DEFAULT 0 by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_ROUND
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns N rounded to M places right of the decimal point. M can -
 be negative to round off digits left of the decimal point. M must be an -
 integer. ';
GRANT EXECUTE ON FUNCTION ROUND TO PUBLIC;

PRINT ' Creating SIGN ';
CREATE FUNCTION SIGN (in DOUBLE PRECISION by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_SIGN
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' If N<0 the function returns - 1; if N = 0 the function returns 0; if N>0 -
 the function returns 1. ';
GRANT EXECUTE ON FUNCTION SIGN TO PUBLIC;

PRINT ' Creating BITAND ';
CREATE FUNCTION BITAND (in INTEGER by value, in INTEGER by value)
     RETURNS INTEGER;
     EXTERNAL NAME SQL$FNC_BITAND
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Return AND of two integer bit masks. ';
GRANT EXECUTE ON FUNCTION BITAND TO PUBLIC;

PRINT ' Creating ASIN ';
CREATE FUNCTION ASIN (in DOUBLE PRECISION by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_ASIN
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns the arc sine of N (an angle expressed in radians). ';
GRANT EXECUTE ON FUNCTION ASIN TO PUBLIC;

PRINT ' Creating ASINH ';
CREATE FUNCTION ASINH (in DOUBLE PRECISION by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_ASINH
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns the hyperbolic arc sine of its argument. ';
GRANT EXECUTE ON FUNCTION ASINH TO PUBLIC;

PRINT ' Creating SIN ';
CREATE FUNCTION SIN (in DOUBLE PRECISION by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_SIN
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns the sine of N (an angle expressed in radians). ';
GRANT EXECUTE ON FUNCTION SIN TO PUBLIC;

PRINT ' Creating SINH ';
CREATE FUNCTION SINH (in DOUBLE PRECISION by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_SINH
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns the hyperbolic sine of N (an angle expressed in radians). ';
GRANT EXECUTE ON FUNCTION SINH TO PUBLIC;

PRINT ' Creating SQRT ';
CREATE FUNCTION SQRT (in DOUBLE PRECISION by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_SQRT
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns the square root of N. The value N cannot be negative. SQRT -
 returns a double precision result. ';
GRANT EXECUTE ON FUNCTION SQRT TO PUBLIC;

PRINT ' Creating ATAN ';
CREATE FUNCTION ATAN (in DOUBLE PRECISION by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_ATAN
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns the arc tangent of N (an angle expressed in radians). ';
GRANT EXECUTE ON FUNCTION ATAN TO PUBLIC;

PRINT ' Creating ATANH ';
CREATE FUNCTION ATANH (in DOUBLE PRECISION by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_ATANH
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns the hyperbolic arc tangent of its argument. ';
GRANT EXECUTE ON FUNCTION ATANH TO PUBLIC;

PRINT ' Creating ATAN2 ';
CREATE FUNCTION ATAN2 (in DOUBLE PRECISION by reference, in DOUBLE PRECISION by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_ATAN2
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns the arc tangent of N and M (an angle expressed in radians). ';
GRANT EXECUTE ON FUNCTION ATAN2 TO PUBLIC;

PRINT ' Creating TAN ';
CREATE FUNCTION TAN (in DOUBLE PRECISION by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_TAN
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns the tangent of N (an angle expressed in radians). ';
GRANT EXECUTE ON FUNCTION TAN TO PUBLIC;

PRINT ' Creating TANH ';
CREATE FUNCTION TANH (in DOUBLE PRECISION by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_TANH
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns the hyperbolic tangent of N (an angle expressed in radians). ';
GRANT EXECUTE ON FUNCTION TANH TO PUBLIC;

PRINT ' Creating TRUNC ';
CREATE FUNCTION TRUNC (in DOUBLE PRECISION by reference, in DOUBLE PRECISION DEFAULT 0 by reference)
     RETURNS DOUBLE PRECISION;
     EXTERNAL NAME SQL$FNC_TRUNC
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns N truncated to M decimal places. M can be negative to -
 truncate (make zero) M digits to the left of the decimal point. ';
GRANT EXECUTE ON FUNCTION TRUNC TO PUBLIC;

-- Character functions returning character values:
PRINT ' Creating CHR ';
CREATE FUNCTION CHR (	in INTEGER by reference)
     RETURNS RDB$ORACLE_SQLFUNC_CHAR_DOM;
     EXTERNAL NAME SQL$FNC_CHR
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE GENERAL
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Returns the character having the binary equivalent to N. ';
GRANT EXECUTE ON FUNCTION CHR TO PUBLIC;

-- Character functions returning number values:
PRINT ' Creating RDB$VARCHAR_TO_ASCII ';
CREATE FUNCTION RDB$VARCHAR_TO_ASCII (in Rdb$ORACLE_SQLFUNC_VCHAR_DOM by descriptor)
     RETURNS INTEGER;
     EXTERNAL NAME SQL$FNC_RDB$VARCHAR_TO_ASCII
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' For Oracle internal use only. ';
GRANT EXECUTE ON FUNCTION RDB$VARCHAR_TO_ASCII TO PUBLIC;

-- Other functions:
PRINT ' Creating HEXTORAW ';
CREATE FUNCTION HEXTORAW (	in Rdb$ORACLE_SQLFUNC_VCHAR_DOM by descriptor)
     RETURNS Rdb$ORACLE_SQLFUNC_VCHAR_DOM by descriptor;
     EXTERNAL NAME SQL$FNC_HEXTORAW
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Converts its argument containing hexadecimal digits to a raw charcter -
 value. ';
GRANT EXECUTE ON FUNCTION HEXTORAW TO PUBLIC;

PRINT ' Creating RAWTOHEX ';
CREATE FUNCTION RAWTOHEX (	in Rdb$ORACLE_SQLFUNC_VCHAR_DOM by descriptor)
     RETURNS Rdb$ORACLE_SQLFUNC_VCHAR_DOM by descriptor;
     EXTERNAL NAME SQL$FNC_RAWTOHEX
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' Converts its raw argument to a character value containing its -
 hexadecimal equivalent. ';
GRANT EXECUTE ON FUNCTION RAWTOHEX TO PUBLIC;

PRINT ' Creating RDB$IS_DEC_MCS_ALPHANUM ';
CREATE FUNCTION RDB$IS_DEC_MCS_ALPHANUM (in Rdb$ORACLE_SQLFUNC_DEC_MCS_DOM by reference)
     RETURNS INTEGER;
     EXTERNAL NAME SQL$FNC_RDB$IS_DEC_MCS_ALPHANUM
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' For Oracle internal use only. ';
GRANT EXECUTE ON FUNCTION RDB$IS_DEC_MCS_ALPHANUM TO PUBLIC;

PRINT ' Creating RDB$IS_ALPHANUM ';
CREATE FUNCTION RDB$IS_ALPHANUM (in RDB$ORACLE_SQLFUNC_CHAR_DOM by reference)
     RETURNS INTEGER;
     EXTERNAL NAME SQL$FNC_RDB$IS_ALPHANUM
     LOCATION 'SQL$FUNCTIONS'
     WITH ALL LOGICAL_NAME TRANSLATION
     LANGUAGE C
     PARAMETER STYLE GENERAL
     NOT VARIANT
     RETURNS NULL ON NULL INPUT
     COMMENT IS ' For Oracle internal use only. ';
GRANT EXECUTE ON FUNCTION RDB$IS_ALPHANUM TO PUBLIC;


-- Stored functions:
--
-- Functions are stored in two modules:Rdb$ORACLE_SQLFUNC_CHAR and
-- Rdb$ORACLE_SQLFUNC_OCTET. The former is defined in SET CHARACTER
-- LENGTH 'CHARACTER' mode. The latter is defined in SET CHARACTER
-- LENGTH 'OCTET' mode. This script restores the mode when it is done.

create module Rdb$ORACLE_SQLFUNC_CHAR
language SQL
comment is 'Oracle SQL emulation functions that operate in SET CHARACTER -
LENGTH ''CHARACTER'' mode.'
function INITCAP (in :S Rdb$ORACLE_SQLFUNC_VCHAR_DOM) -- needs charset work
returns Rdb$ORACLE_SQLFUNC_VCHAR_DOM
comment is 'Returns the string argument, with the first letter of each -
work in uppercase, all other letters in lower case. Words are delimited -
by non-alphanumeric characters.';
begin
    declare :I	 integer;
    declare :DOCAP integer;
    declare :R	 Rdb$ORACLE_SQLFUNC_VCHAR_DOM;
    declare :S0	 char(1);
    set :R = :S;
    set :DOCAP = 1;
    set :I = 1;
    while (:I <= character_length(:S)) loop
        begin
        set :S0 = substring(:S from :I for 1);
        if (RDB$IS_ALPHANUM (:S0) <> 1) then
            begin
            set :DOCAP = 1;
            end;
        elseif (:DOCAP = 1) then
            begin
            set :R = substring(:R from 1 for :I-1)
                ||	 upper (substring(:R from :I for 1))
                ||	 substring(:R from :I+1);
            set :DOCAP = 0;
            end;
        else
            begin
            set :R = substring(:R from 1 for :I-1)
                ||	 lower (substring(:R from :I for 1))
                ||	 substring(:R from :I+1);
            set :DOCAP = 0;
            end;
        end if;
        set :I = :I + 1;
        end;
    end loop;
    return :R;
end;

function LPAD (in :S Rdb$ORACLE_SQLFUNC_VCHAR_DOM,
    in :L integer, in :P Rdb$ORACLE_SQLFUNC_VCHAR_DOM)
returns Rdb$ORACLE_SQLFUNC_VCHAR_DOM
comment is 'Returns S left padded to length L with the sequence of -
characters in P. If S is longer than L, this function returns that -
portion of S that fits in L.';
begin
    declare :PS Rdb$ORACLE_SQLFUNC_VCHAR_DOM;
    if ((:L<character_length(:S)) or (character_length(:P) <= 0)) then
        begin
        return substring (:S from 1 for :L);
        end;
    end if;
    set :PS = substring(:P from 1 for :L - character_length(:S));
    while ((character_length(:S) + character_length(:PS))<:L) loop
        begin
        set :PS = :PS || substring(:P from 1
            for :L - (character_length(:S)+character_length(:PS)));
        end;
    end loop;
    return :PS || :S;
end;

function LTRIM (in :S1 Rdb$ORACLE_SQLFUNC_VCHAR_DOM,
    in :S2 Rdb$ORACLE_SQLFUNC_VCHAR_DOM default ' ')
returns Rdb$ORACLE_SQLFUNC_VCHAR_DOM
comment is 'Removes characters from the left of S1, with initial -
characters removed up to the first character not in S2.';
begin
    declare :I, :J integer;
    set :I = 0;
    set :J = 0;
S1_LOOP:
    while (:I <= character_length(:S1)) loop
        begin
        if (position (substring(:S1 from :I for 1) in :S2) = 0) then
            begin
            leave S1_LOOP;
            end;
        end if;
        set :I = :I + 1;
        end;
    end loop;
    return substring (:S1 from :I);
end;

function REPLACE (in :S1 Rdb$ORACLE_SQLFUNC_VCHAR_DOM,
    in :S2 Rdb$ORACLE_SQLFUNC_VCHAR_DOM default '',
    in :S3 Rdb$ORACLE_SQLFUNC_VCHAR_DOM default '')
returns Rdb$ORACLE_SQLFUNC_VCHAR_DOM
comment is 'Returns S1 with every occurence of S2 replaced by S3.';
begin
    declare :P1, :P2, :L2, :L3 integer;
    declare :R Rdb$ORACLE_SQLFUNC_VCHAR_DOM;
    set :L2 = character_length (:S2);
    set :L3 = character_length (:S3);
    set :P1 = position (:S2 in :S1);
    if (:L2 = 0) then
        begin
        return :S1;
        end;
    end if;
    set :R = :S1;
    while (:P1 <> 0) loop
        begin
        set :R = substring (:R from 1 for (:P1 - 1))
            || :S3
            || substring(:R from (:P1+:L2));
        set :P2 = position(:S2 in substring (:R from (:P1+:L3)));
        if (:P2 <> 0) then
            begin
            set :P1 = :P1 + :L3 + :P2 - 1;
            end;
        else
            begin
            set :P1 = 0;
            end;
        end if;
        end;
    end loop;
    return :R;
end;

function RPAD (in :S Rdb$ORACLE_SQLFUNC_VCHAR_DOM, in :L integer, in :P
    Rdb$ORACLE_SQLFUNC_VCHAR_DOM default ' ')
returns Rdb$ORACLE_SQLFUNC_VCHAR_DOM
comment is 'Returns S left padded to length L with the sequence of -
characters in P. If S is longer than L, this function returns that -
portion of S that fits in L.';
begin
    declare :R Rdb$ORACLE_SQLFUNC_VCHAR_DOM;
    if ((:L<character_length(:S)) or (character_length(:P) <= 0)) then
        begin
        return substring (:S from 1 for :L);
        end;
    end if;
    set :R = :S;
    while (character_length(:R)<:L) loop
        begin
        set :R = :R || substring(:P from 1 for :L - character_length(:R));
        end;
    end loop;
    return :R;
end;

function RTRIM (in :S1 Rdb$ORACLE_SQLFUNC_VCHAR_DOM,
    in :S2 Rdb$ORACLE_SQLFUNC_VCHAR_DOM default ' ')
returns Rdb$ORACLE_SQLFUNC_VCHAR_DOM
comment is 'Returns S1 with final characters after the last character not -
in S2.';
begin
    declare :I, :J integer;
    set :I = character_length(:S1);
    set :J = 0;
S1_LOOP:
    while (:I>0) loop
        begin
        if (position (substring(:S1 from :I for 1) in :S2) = 0) then
            begin
            leave S1_LOOP;
            end;
        end if;
        set :I = :I - 1;
        end;
    end loop;
    return substring (:S1 from 1 for :I);
end;

function SUBSTR (in :S Rdb$ORACLE_SQLFUNC_VCHAR_DOM,
    in :P integer, in :L integer default 0)
returns Rdb$ORACLE_SQLFUNC_VCHAR_DOM
comment is 'Returns a portion of S, beginning at P, L characters long. -
If P is negative, SUBSTR counts backwards from the end of S.';
begin
    declare :P3 integer;
    if (:L = 0) then
        begin
        set :P3 = character_length(:S);
        end;
    else
        begin
        set :P3 = :L;
        end;
    end if;
    if (:P >= 0) then
        begin
        return substring (:S from :P for :P3);
        end;
    else
        begin
        declare :P2 integer;
        set :P2 = character_length(:S) + :P + 1;
        if (:P2<1) then
            begin
            return substring (:S from 1 for 0);
            end;
        else
            begin
            return substring (:S from :P2 for :P3);
            end;
        end if;
        end;
    end if;
end;

function ASCII (in :S Rdb$ORACLE_SQLFUNC_VCHAR_DOM)
returns integer
comment is 'Returns the decimal representation of the first character of -
its argument.';
begin
    return RDB$VARCHAR_TO_ASCII (substring (:S from 1 for 1));
end;

function INSTR (in :S1 Rdb$ORACLE_SQLFUNC_VCHAR_DOM,
     in :S2 Rdb$ORACLE_SQLFUNC_VCHAR_DOM,
     in :N integer default 1, in :M integer default 1)
returns integer
comment is ' Searches S1 beginning with its Nth character and returns -
 the position of the Mth occurrence of S2 or 0 if S2 does not occur M -
 times. If N<0 starts at the end of S1. ';
begin
     declare :C, :P, :A, :N2, :L2 integer;
     declare :S Rdb$ORACLE_SQLFUNC_VCHAR_DOM;
     if (character_length (:S2) = 0) then
          begin
          return cast (NULL as integer);
          end;
     end if;
     if (:N = 0) then
          begin
          return 0;
          end;
     end if;
     if (:M = 0) then
          begin
          return :N;
          end;
     end if;
     if (:M<0) then
          begin
          return :M / 0;
          end;
     end if;
     if (character_length (:S1)<character_length (:S2)) then
          begin
          return 0;
          end;
     end if;
     set :C = 0;
     if (:N>0) then
          begin
          set :A = :N;
          set :P = 0;
          while (:C<:M) loop
               begin
               set :A = :A + :P;
               set :S = substring (:S1 from :A);
               set :P = position (:S2 in :S);
               if (:P = 0) then
                    begin
                    return 0;
                    end;
               end if;
               set :C = :C + 1;
               end;
          end loop;
          return (:P + :A) - 1;
          end;
     else
          begin
          if (character_length (:S1) <= (- :N)) then
               begin
               return 0;
               end;
          end if;
          set :L2 = character_length (:S2);
          set :P = character_length (:S1);      -- start at end
          set :P = :P - (:L2 - 1);           -- allow 1 instance
          set :N2 = (- :N) - 1;                -- :N2 is 0 - based positive :N
          set :P = :P - :N2;                -- back off specified amount
          if (:P<1) then
               begin
               return 0;
               end;
          end if;
          loop
               begin
               if (substring (:S1 from :P for :L2) = :S2) then
                    begin
                    set :C = :C + 1;
                    end;
               else
                    begin
                    end;
               end if;
               if (:C >= :M) then return :P;
               end if;
               set :P = :P - 1;
               if (:P<1) then return 0;
               end if;
               end;
          end loop;
          end;
     end if;
end;

function LENGTH (in :S Rdb$ORACLE_SQLFUNC_VCHAR_DOM)
returns integer
comment is 'Returns the length of S in characters.';
begin
    return character_length (:S);
end;

function LAST_DAY
    (in :D Rdb$ORACLE_SQLFUNC_DATE_DOM)
returns Rdb$ORACLE_SQLFUNC_DATE_DOM
comment is 'Returns the last day of the month that contains D.';
begin
    return cast (
        cast (:D as timestamp) +
        cast (case
            when extract (month from :D) in (4,6,9,11) then 30
            when extract (month from :D) = 2 then
                case MOD (extract (year from :D), 400)
                    when 0 then 29
                    else case MOD (extract (year from :D), 100)
                        when 0 then 28
                        else case MOD (extract (year from :D), 4)
                            when 0 then 29
                            else 28
                        end
                    end
                end
            else 31
        end - extract (day from :D) as interval day(9))
    as Rdb$ORACLE_SQLFUNC_DATE_DOM);
end;

function ADD_MONTHS
    (in :D Rdb$ORACLE_SQLFUNC_DATE_DOM,
    in :N integer)
returns Rdb$ORACLE_SQLFUNC_DATE_DOM
comment is 'Returns the date D plus N months.';
begin
    declare :M_RESULT Rdb$ORACLE_SQLFUNC_DATE_DOM;
    set :M_RESULT = cast (
        cast (:D as timestamp) + cast (:N as interval month(9))
    as Rdb$ORACLE_SQLFUNC_DATE_DOM);
    if (LAST_DAY(:D) = :D) then
        begin
        return LAST_DAY (:M_RESULT);
        end;
    else
        begin
        return :M_RESULT;
        end;
    end if;
end;

function MONTHS_BETWEEN
    (in :D1 Rdb$ORACLE_SQLFUNC_DATE_DOM,
     in :D2 Rdb$ORACLE_SQLFUNC_DATE_DOM)
returns double precision
comment 'Returns the number months between dates D1 and D2.';
begin
    declare :YR1, :MO1, :DY1, :HR1, :MI1, :SE1 integer;
    declare :YR2, :MO2, :DY2, :HR2, :MI2, :SE2 integer;
    declare :R double precision;
    set :YR1 = extract (year from :D1);
    set :MO1 = extract (month from :D1);
    set :DY1 = extract (day from :D1);
    set :HR1 = extract (hour from :D1);
    set :MI1 = extract (minute from :D1);
    set :SE1 = extract (second from :D1);
    set :YR2 = extract (year from :D2);
    set :MO2 = extract (month from :D2);
    set :DY2 = extract (day from :D2);
    set :HR2 = extract (hour from :D2);
    set :MI2 = extract (minute from :D2);
    set :SE2 = extract (second from :D2);
    set :R = (cast ((:YR1 - :YR2) as double precision) * 12.0)
        + (cast ((:MO1 - :MO2) as double precision));
    if ((:DY1 = :DY2)
    or ((:D1 = LAST_DAY(:D1)) and (:D2 = LAST_DAY(:D2)))) then
        begin
        return :R;
        end;
    end if;
    set :R = :R + (cast ((:DY1 - :DY2) as double precision) / 31.0)
        + (cast ((:HR1 - :HR2) as double precision) / (24.0*31.0))
        + (cast ((:MI1 - :MI2) as double precision) / (60.0*24.0*31.0))
        + (cast ((:SE1 - :SE2) as double precision) / (60.0*60.0*24.0*31.0));
    return :R;
end;

function Rdb$GMT_OFFSET (in :Z Rdb$ORACLE_SQLFUNC_VCHAR_DOM)
returns interval hour to minute
comment is 'For ORACLE internal use only.';
begin
    return case upper(:Z)
        when ('AST') then interval '-04:00' hour to minute
        when ('ADT') then interval '-03:00' hour to minute
        when ('BST') then interval '-11:00' hour to minute
        when ('BDT') then interval '-10:00' hour to minute
        when ('CST') then interval '-06:00' hour to minute
        when ('CDT') then interval '-05:00' hour to minute
        when ('EST') then interval '-05:00' hour to minute
        when ('EDT') then interval '-04:00' hour to minute
        when ('GMT') then interval '00:00' hour to minute
        when ('HST') then interval '-10:00' hour to minute
        when ('HDT') then interval '-09:00' hour to minute
        when ('MST') then interval '-07:00' hour to minute
        when ('MDT') then interval '-06:00' hour to minute
        when ('NST') then interval '-03:30' hour to minute
        when ('PST') then interval '-08:00' hour to minute
        when ('PDT') then interval '-07:00' hour to minute
        when ('YST') then interval '-09:00' hour to minute
        when ('YDT') then interval '-08:00' hour to minute
        end;
end;

function NEW_TIME (in :D Rdb$ORACLE_SQLFUNC_DATE_DOM,
    in :Z1 Rdb$ORACLE_SQLFUNC_VCHAR_DOM,
    in :Z2 Rdb$ORACLE_SQLFUNC_VCHAR_DOM)
returns Rdb$ORACLE_SQLFUNC_DATE_DOM
comment is 'Returns the date/time in time zone Z2 when the date/time in -
time zone Z1 is D. Time zones Z1 and Z1 can be:AST, ADT, BST, BDT, -
CST, CDT, EST, EDT, GMT, HST, HDT, MST, MDT, NST, PST, PDT, YST, or YDT.';
begin
    return cast (
        (cast (:D as timestamp) + (Rdb$GMT_OFFSET(:Z2)
            - Rdb$GMT_OFFSET(:Z1)))
    as Rdb$ORACLE_SQLFUNC_DATE_DOM);
end;

function NEXT_DAY
    (in :D Rdb$ORACLE_SQLFUNC_DATE_DOM,
     in :DAYNAME Rdb$ORACLE_SQLFUNC_VCHAR_DOM)
returns Rdb$ORACLE_SQLFUNC_DATE_DOM
comment is 'Returns the date of the first weekday named by DAYNAME that -
is later than the date D.';
begin
    declare :DY integer;
    set :DY = case upper (:DAYNAME)
        when 'MONDAY' then 1
        when 'TUESDAY' then 2
        when 'WEDNESDAY' then 3
        when 'THURSDAY' then 4
        when 'FRIDAY' then 5
        when 'SATURDAY' then 6
        when 'SUNDAY' then 7
        else 1/0
    end - extract (weekday from :D);
    return cast (
        cast (:D as timestamp) + cast (case
            when :DY <= 0 then 7 + :DY
            else :DY
        end as interval day)
    as Rdb$ORACLE_SQLFUNC_DATE_DOM);
end;

end module; -- Rdb$ORACLE_SQLFUNC_CHAR
grant execute on module Rdb$ORACLE_SQLFUNC_CHAR to public;

set character length 'OCTET';

create module Rdb$ORACLE_SQLFUNC_OCTET
language SQL
comment is 'Oracle SQL emulation functions that operate in SET -
CHARACTER LENGTH ''OCTET'' mode.'

function INSTRB (in :S1 Rdb$ORACLE_SQLFUNC_VCHAR_DOM,
     in :S2 Rdb$ORACLE_SQLFUNC_VCHAR_DOM,
     in :N integer default 1, in :M integer default 1)
returns integer
comment is ' Searches S1 beginning with its Nth octet and returns -
 the position of the Mth occurrence of S2 or 0 if S2 does not occur M -
 times. If N<0 starts at the end of S1. ';
begin
     declare :C, :P, :A, :N2, :L2 integer;
     declare :S Rdb$ORACLE_SQLFUNC_VCHAR_DOM;
     if (octet_length (:S2) = 0) then
          begin
          return cast (NULL as integer);
          end;
     end if;
     if (:N = 0) then
          begin
          return 0;
          end;
     end if;
     if (:M = 0) then
          begin
          return :N;
          end;
     end if;
     if (:M<0) then
          begin
          return :M / 0;
          end;
     end if;
     if (octet_length (:S1)<octet_length (:S2)) then
          begin
          return 0;
          end;
     end if;
     set :C = 0;
     if (:N>0) then
          begin
          set :A = :N;
          set :P = 0;
          while (:C<:M) loop
               begin
               set :A = :A + :P;
               set :S = substring (:S1 from :A);
               set :P = position (:S2 in :S);
               if (:P = 0) then
                    begin
                    return 0;
                    end;
               end if;
               set :C = :C + 1;
               end;
          end loop;
          return (:P + :A) - 1;
          end;
     else
          begin
          if (octet_length (:S1) <= (- :N)) then
               begin
               return 0;
               end;
          end if;
          set :L2 = octet_length (:S2);
          set :P = octet_length (:S1);      -- start at end
          set :P = :P - (:L2 - 1);           -- allow 1 instance
          set :N2 = (- :N) - 1;                -- :N2 is 0 - based positive :N
          set :P = :P - :N2;                -- back off specified amount
          if (:P<1) then
               begin
               return 0;
               end;
          end if;
          loop
               begin
               if (substring (:S1 from :P for :L2) = :S2) then
                    begin
                    set :C = :C + 1;
                    end;
               else
                    begin
                    end;
               end if;
               if (:C >= :M) then return :P;
               end if;
               set :P = :P - 1;
               if (:P<1) then return 0;
               end if;
               end;
          end loop;
          end;
     end if;
end;

function SUBSTRB (in :S Rdb$ORACLE_SQLFUNC_VCHAR_DOM,
    in :P integer, in :L integer default 0)
returns Rdb$ORACLE_SQLFUNC_VCHAR_DOM
comment is 'Same as SUBSTR, except P and L are expressed in bytes rather -
than characters.';
begin
    declare :P3 integer;
    if (:L = 0) then
        begin
        set :P3 = character_length(:S);
        end;
    else
        begin
        set :P3 = :L;
        end;
    end if;
    if (:P >= 0) then
        begin
        return substring (:S from :P for :P3);
        end;
    else
        begin
        declare :P2 integer;
        set :P2 = character_length(:S) + :P + 1;
        if (:P2<1) then
            begin
            return substring (:S from 1 for 0);
            end;
        else
            begin
            return substring (:S from :P2 for :P3);
            end;
        end if;
        end;
    end if;
end;

function LENGTHB (in :S Rdb$ORACLE_SQLFUNC_VCHAR_DOM)
returns integer
comment is 'Returns the length of S in bytes.';
begin
    return octet_length (:S);
end;

end module; -- Rdb$ORACLE_SQLFUNC_OCTET
grant execute on module Rdb$ORACLE_SQLFUNC_OCTET to public;

set character length :Rdb_CHARACTER_LENGTH_MODE;
undeclare :Rdb_CHARACTER_LENGTH_MODE;

print 'Type COMMIT if there were no unexpected errors, otherwise ROLLBACK';
print ' If you later wish to drop: Use @SQL_FUNCTIONS_DROP72.SQL ';
set dialect :Rdb_DIALECT;
set quoting rules :Rdb_QUOTING;
undeclare :Rdb_DIALECT;
undeclare :Rdb_QUOTING;
set warning deprecate;