-- Copyright © Oracle Corporation 1995-1996. All Rights Reserved. print 'Copyright © Oracle Corporation 1995-1996. All Rights Reserved.'; print ' '; -- "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) and the" -- "Rdb$ORACLE_SQLFUNC_DATE_DOM domain as DATE VMS in the default character set." -- "You can override these settings by defining these domains with the settings of" -- "your choice. Then either ROLLBACK or run the SQL_FUNCTIONS_DROP.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." -- set dialect 'SQLV40'; create function Rdb$ORACLE_SQLFUNC_INTRO () returns integer; external name Rdb$ORACLE_SQLFUNC_INTRO location 'SQL$FUNCTIONS' with all logical_name translation language c general parameter style not variant comment is 'For Oracle internal use only.'; declare :Rdb$DUMMY integer; begin set :Rdb$DUMMY = Rdb$ORACLE_SQLFUNC_INTRO(); end; undeclare :Rdb$DUMMY; drop function Rdb$ORACLE_SQLFUNC_INTRO; -- Save the current character-length mode in :Rdb$CHARACTER_LENGTH_MODE. -- We 'll use it later to restore the mode. declare :Rdb$CHARACTER_LENGTH_MODE char(20); declare :Rdb$KANJI_VAR varchar(20) character set kanji; begin set :Rdb$KANJI_VAR = _kanji 'ab'; set :Rdb$CHARACTER_LENGTH_MODE = case octet_length(substring(:Rdb$KANJI_VAR from 1 for 1)) when 1 then 'OCTET' else 'CHARACTER' end; end; undeclare :Rdb$KANJI_VAR; 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; -- External functions: -- Rdb SQL functions fashioned after Oracle SQL functions: -- Number functions: 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 GENERAL PARAMETER STYLE NOT VARIANT COMMENT IS 'Returns the absolute value of N. '; 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 GENERAL PARAMETER STYLE NOT VARIANT COMMENT IS 'Returns the smallest integer greater than or equal to N. '; 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 GENERAL PARAMETER STYLE NOT VARIANT COMMENT IS 'Returns the cosine of N (an angle expressed in radians). '; 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 GENERAL PARAMETER STYLE NOT VARIANT COMMENT IS 'Returns the hyperbolic cosine of N (an angle expressed in radians). '; 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 GENERAL PARAMETER STYLE NOT VARIANT COMMENT IS 'Returns e raised to the Nth power (e=2.71828183...). '; 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 GENERAL PARAMETER STYLE NOT VARIANT COMMENT IS 'Returns the largest integer equal to or less than N. '; 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 GENERAL PARAMETER STYLE NOT VARIANT COMMENT IS 'Returns the natural logarithm of N where N is greater than 0. '; 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 GENERAL PARAMETER STYLE NOT VARIANT 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. '; 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 GENERAL PARAMETER STYLE NOT VARIANT COMMENT IS 'Returns the remainder of M divided by N. Returns M if N is 0. '; 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 GENERAL PARAMETER STYLE NOT VARIANT 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. '; CREATE FUNCTION ROUND (in DOUBLE PRECISION by reference , in DOUBLE PRECISION by reference ) RETURNS DOUBLE PRECISION; EXTERNAL NAME SQL$FNC_ROUND LOCATION 'SQL$FUNCTIONS' WITH ALL LOGICAL_NAME TRANSLATION LANGUAGE C GENERAL PARAMETER STYLE NOT VARIANT 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. '; 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 GENERAL PARAMETER STYLE NOT VARIANT COMMENT IS 'If N<0 the function returns -1; if N=0 the function returns 0; if N>0 - the function returns 1. '; 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 GENERAL PARAMETER STYLE NOT VARIANT COMMENT IS 'Returns the sine of N (an angle expressed in radians). '; 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 GENERAL PARAMETER STYLE NOT VARIANT COMMENT IS 'Returns the hyperbolic sine of N (an angle expressed in radians). '; 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 GENERAL PARAMETER STYLE NOT VARIANT COMMENT IS 'Returns the square root of N. The value N cannot be negative. SQRT - returns a double precesion result. '; 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 GENERAL PARAMETER STYLE NOT VARIANT COMMENT IS 'Returns the tangent of N (an angle expressed in radians). '; 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 GENERAL PARAMETER STYLE NOT VARIANT COMMENT IS 'Returns the hyperbolic tangent of N (an angle expressed in radians). '; CREATE FUNCTION TRUNC (in DOUBLE PRECISION by reference , in DOUBLE PRECISION by reference ) RETURNS DOUBLE PRECISION; EXTERNAL NAME SQL$FNC_TRUNC LOCATION 'SQL$FUNCTIONS' WITH ALL LOGICAL_NAME TRANSLATION LANGUAGE C GENERAL PARAMETER STYLE NOT VARIANT 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. '; -- Character functions returning character values: CREATE FUNCTION CHR ( in INTEGER by reference ) RETURNS Rdb$ORACLE_SQLFUNC_VCHAR_DOM; EXTERNAL NAME SQL$FNC_CHR LOCATION 'SQL$FUNCTIONS' WITH ALL LOGICAL_NAME TRANSLATION LANGUAGE C GENERAL PARAMETER STYLE NOT VARIANT COMMENT IS 'Returns the character having the binary equivalent to N. '; -- Character functions returning number values: 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 GENERAL PARAMETER STYLE NOT VARIANT COMMENT IS 'For Oracle internal use only. '; -- Other functions: 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 GENERAL PARAMETER STYLE NOT VARIANT COMMENT IS 'Converts its argument containing hexadecimal digits to a raw charcter - value. '; 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 GENERAL PARAMETER STYLE NOT VARIANT COMMENT IS 'Converts its raw argument to a charcter value containing its - hexadecimal equivalent. '; 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 GENERAL PARAMETER STYLE NOT VARIANT COMMENT IS 'For Oracle internal use only. '; -- 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 GREATEST (in :V1 double precision, in :V2 double precision) returns double precision comment is 'Returns the greater of V1 or V2. Restricted to exactly - 2 numeric arguments '; begin if (:V2 > :V1) then begin return :V2; end; else begin return :V1; end; end if; end; function LEAST (in :V1 double precision, in :V2 double precision) returns double precision comment is 'Returns the lessor of V1 or V2. Restricted to exactly - 2 numeric arguments '; begin if (:V2 < :V1) then begin return :V2; end; else begin return :V1; end; end if; end; 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) character set dec_mcs; set :R = :S; set :DOCAP = 1; set :I = 1; while (:I <= character_length(:S)) loop begin set :S0 = translate (substring(:S from :I for 1) using Rdb$DEC_MCS); if (Rdb$IS_DEC_MCS_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) 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, in :S3 Rdb$ORACLE_SQLFUNC_VCHAR_DOM) 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) 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) 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) 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 if (:P >= 0) then begin return substring (:S from :P for :L); 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 :L); 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, in :M integer) 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 :RESULT Rdb$ORACLE_SQLFUNC_DATE_DOM; set :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 (:RESULT); end; else begin return :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 translate(upper(:Z) using Rdb$DEC_MCS) 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 translate (upper (:DAYNAME) using Rdb$DEC_MCS) 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 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, in :M integer) 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) returns Rdb$ORACLE_SQLFUNC_VCHAR_DOM comment is 'Same as SUBSTR, except P and L are expressed in bytes rather - than characters.'; begin if (:P >= 0) then begin return substring (:S from :P for :L); 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 :L); 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 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_DROP.SQL '; set dialect 'ORACLE LEVEL1'; print '%Info: Your SQL dialect is now Oracle Level1';