Programmer's ROM - The Computer Language Library

home *** CD-ROM | disk | FTP | other *** search

/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / misc / tod.ada < prev next >

Wrap

Text File | 1988-05-03 | 76.7 KB | 1,904 lines

-------- SIMTEL20 Ada Software Repository Prologue ------------ -- -* -- Unit name : package TOD_Utilities -- Version : 1.0 (MOOV115) -- Author : Geoffrey O. Mendal -- : Stanford University -- : Computer Systems Laboratory -- : Stanford, CA 94305 -- : (415) 497-1414 or 497-1175 -- DDN Address : Mendal@SU-SIERRA.ARPA -- Copyright : (c) 1985 Geoffrey O. Mendal -- Date created : Mon 11 Nov 85 -- Release date : Sun 25 Dec 85 -- Last update : MENDAL Sun 25 Dec 85 -- Machine/System Compiled/Run on : DG MV10000, ROLM ADE -- VAX 11/780, DEC ACS -- RATIONAL R1000 -- Dependent Units : package CALENDAR -- generic package Search_Utilities -- -* --------------------------------------------------------------- -- -* -- Keywords : TIME ----------------: DAY ----------------: DATE ----------------: TIME CONVERSION ----------------: DATE CONVERSION -- -- Abstract : This package contains time-of-day conversion ----------------: routines. One routine takes practically ----------------: any time/date STRING and converts it to ----------------: CALENDAR.TIME format. The other routine takes ----------------: a CALENDAR.TIME value and converts it to a ----------------: STRING containing the day name, full date, ----------------: and time (resolution to the nearest second). -- -* ------------------ Revision history --------------------------- -- -* -- DATE VERSION AUTHOR HISTORY -- 12/29/85 1.0 (MOOV115) Mendal Initial Release -- -* ------------------ Distribution and Copyright ----------------- -- -* -- This prologue must be included in all copies of this software. -- -- This software is copyright by the author. -- -- This software is released to the Ada community. -- This software is released to the Public Domain (note: -- software released to the Public Domain is not subject -- to copyright protection). -- Restrictions on use or distribution: NONE -- -* ------------------ Disclaimer --------------------------------- -- -* -- This software and its documentation are provided "AS IS" and -- without any expressed or implied warranties whatsoever. -- No warranties as to performance, merchantability, or fitness -- for a particular purpose exist. -- -- Because of the diversity of conditions and hardware under -- which this software may be used, no warranty of fitness for -- a particular purpose is offered. The user is advised to -- test the software thoroughly before relying on it. The user -- must assume the entire risk and liability of using this -- software. -- -- In no event shall any person or organization of people be -- held responsible for any direct, indirect, consequential -- or inconsequential damages or lost profits. -- -* -------------------END-PROLOGUE-------------------------------- -- This package will provide direct conversion from an external -- time/date string to the internal Ada CALENDAR.TIME representation -- and visa versa. Most free format external representations are -- supported. Components of an external format include: -- Year, Month and Day (as numbers and strings), Hour, Minutes, -- and Seconds -- As long as the external representation can be parsed unambiguously, -- this package should be able to handle the conversion. Examples of -- valid external formats: -- 7pm Fr March 12, 1982 -- 15 Dec. 84 12:36PM -- YESTERDAY 3PM -- 6/01/83 <-- defaults to 12:00:00AM -- 3:45AM <-- defaults to the current date -- 18:07:35 <-- defaults to the current date -- 8-26 <-- defaults to 12:00:00AM of the current year -- friday <-- defaults to 12:00:00AM of the current or next -- future Friday -- Examples of invalid external representations: -- 2/31/84 <-- February never has a 31st day -- 12:3605/01/84 <-- too tough to parse (nondeterminstic) -- 3/8423:00:00 <-- too tough to parse (nondeterminstic) -- 3:54:29AMTues <-- too tough to parse (nondeterminstic) -- Nov 1983 <-- must always include day number in the date -- Sun 8/3/84 <-- 8/3/84 was a Friday -- Optional periods may be placed after ABBREVIATED day/month names. -- All external formats are converted to upper case, so there are no -- problems with specifying mixed and/or lower case input. All -- results are returned in upper case by default (which can be overridden -- by specifying lower case or mixed case). -- Special external formats: TODAY, TOMORROW, YESTERDAY, NOW -- TODAY is equivalent to 12AM of the current date. TOMORROW and -- YESTERDAY are equivalent to the next/previous date. NOW is -- equivalent to calling the function CALENDAR.CLOCK . -- Defaults: -- If the year is omitted, it defaults to the current year. If the -- time is omitted, it defaults to 12:00:00AM. If the day name and no -- date is specified, the current or next future date is assumed. If -- only the time is specified, the current date is assumed. If the -- minutes and/or seconds are not specified in the time, they default -- to zero. If the year is given in short format (1 or 2 digits) then -- it defaults to the current century. -- BNF for the external representation: -- {<special_format> [<time>] | -- [<time>] <special_format> | -- <day_string> &|* <date> &|* <time>} -- <special_format> ::= {TODAY | TOMORROW | YESTERDAY | NOW} -- <day_string> ::= SU|NDAY, MO|NDAY, ..., SA|TURDAY -- <date> ::= {<month_number><sep1><day_number>[<sep1><year_number>] | -- <month_name><sep2><day_number>[<sep2><year_number>] | -- <day_number><sep2><month_name>[<sep2><year_number>] | -- <full_year_number><sep2><month_name><sep2><day_number> | -- <full_year_number><sep2><day_number><sep2><month_name>} -- <time> ::= {<hour>':'<minutes>[':'<seconds>][<AM_PM>] | -- <AMPM_hour><AM_PM>} -- <month_number> ::= 1 .. 12 -- <month_name> ::= JAN|UARY, FEB|RUARY, ..., DEC|EMBER -- <day_number> ::= 1 .. 31 -- <year_number> ::= {<short_year_number> | <full_year_number>} -- <short_year_number> ::= [0]0 .. 99 <-- for century 2000 -- [0]1 .. 99 <-- for century 2100 -- <full_year_number> ::= 1901 .. 2099 -- <sep1> ::= {'-'|'/'} -- <sep2> ::= {<sep1> | {' ' | ','} ...} -- <hour> ::= [0]0 .. 24 -- <AMPM_hour> ::= [0]1 .. 12 -- <minutes> ::= 00 .. 59 -- <seconds> ::= 00 .. 59 -- <AM_PM> ::= {"AM" | "PM"} -- Notes on the BNF above: -- Items in angle brackets must be separated by at least one -- blank and/or comma when they appear with exactly one space -- between them. -- However, items in angle brackets which are not separated by -- exactly one blank have a more rigid syntax, and must be followed -- precisely as specified in the BNF. -- Some characters/strings are enclosed in quotes to emphasize that -- they are explicit, and not metasymbols. When specifying an -- external TOD_STRING, do NOT include the quotes. -- The AM/PM indicator may be left off the time if at least the -- hours and minutes are specified. If only the hour is specified, -- it must be in the range 01 .. 12 and must have the AM/PM -- indicator following it. If the AM/PM indicator is left off a -- time format, AM is assumed unless the hour is in the range -- 13 .. 23 . If the AM/PM indicator is included, the hour must -- be in the range 01 .. 12 . -- Notation: -- {...|...|...} -- select exactly one alternative -- [...] -- optional -- &| -- select one or the other or both -- &|* -- same as &| with the extension of selecting -- the items in any order -- ' ' -- encloses a character literal -- " " -- encloses a string -- < > -- encloses a non-terminal symbol -- ... -- denotes a repeatable field -- | -- separates alternatives and denotes valid -- -- abbreviations with CALENDAR; -- predefined (internal representation) TOD package package TOD_UTILITIES is Tod_Utilities_Version : constant STRING := "1.51 MOOV115"; -- the following type should be used to retrieve an external TOD -- representation from the CALENDAR.TIME representation. External_TOD_Representation_Length : constant POSITIVE := 38; subtype EXTERNAL_TOD_REPRESENTATION_TYPE is STRING(1 .. External_TOD_Representation_Length); -- the following type should be used to specify the type set of an -- external representation returned by the internal-to-external -- function below. type TYPE_SET is (UPPER_CASE,lower_case,Mixed_Case); -- the following function will take the CALENDAR.TIME representation -- and return an external representation. The external representation -- has the following format: -- columns 1 .. 9 : Day as a string -- columns 11 .. 12 : Day as a number -- columns 14 .. 22 : Month as a string -- columns 24 .. 27 : year number -- columns 29 .. 38 : time in AM/PM format -- all unused columns are blank -- Example string returned: -- "THURSDAY 09 AUGUST 1984 05:19:05PM" function CONVERT_INTERNAL_TOD_TO_EXTERNAL_TOD( TOD_VALUE : in CALENDAR.TIME; DEFAULT_SETTING : in TYPE_SET := UPPER_CASE) return EXTERNAL_TOD_REPRESENTATION_TYPE; -- the following function will take an external TOD representation -- and return the CALENDAR.TIME representation. The external -- representation can be any constrained STRING that conforms to -- the BNF given above. function CONVERT_EXTERNAL_TOD_TO_INTERNAL_TOD( TOD_STRING : in STRING) return CALENDAR.TIME; -- the following exceptions will be raised if the input to the -- function CONVERT_EXTERNAL_TOD_TO_INTERNAL_TOD cannot be parsed -- unambiguously. Also, that function traps CALENDAR.TIME_ERROR and -- instead raises the exception DATE_ERROR below in its place. DUPLICATION_ERROR, -- "5/25/61 May 25 1961" DATE_ERROR, -- "2/31/75" MONTH_NUMBER_ERROR, -- "13/1/1960" YEAR_ERROR, -- "1/1/1900" DAY_NUMBER_ERROR, -- "1/32/1984" DAY_DATE_ERROR, -- "Sunday 8/3/84" MONTH_MISSING_ERROR, -- "1961 25" DAY_NUMBER_MISSING_ERROR, -- "1961 May" HOUR_ERROR, -- "25:00:00" MINUTE_ERROR, -- "23:61:00" SECOND_ERROR, -- "23:59:60" TIME_STRING_ERROR, -- "1:05:05:PM" ABBREVIATION_ERROR, -- "Sept.emb. 5" EXTERNAL_REPRESENTATION_ERROR : exception; -- "blah blah blah" end TOD_UTILITIES; -- Example use: -- with TOD_UTILITIES, TEXT_IO, CALENDAR; -- ... -- procedure Print_Time_In_Readable_Format( -- Ada_Time_Format : CALENDAR.TIME := CALENDAR.CLOCK) is -- ... -- begin -- ... -- TEXT_IO.PUT_LINE( -- TOD_UTILITIES.CONVERT_INTERNAL_TOD_TO_EXTERNAL_TOD(TOD_VALUE=>Ada_Time_Format)); -- ... -- end Print_Time_In_Readable_Format; -- ... -- procedure Convert_TOD_String_To_Ada_Predefined_Format( -- TOD_String : STRING := "TODAY") is -- ... -- Ada_Time_Format : CALENDAR.TIME; -- ... -- begin -- ... -- Ada_Time_Format := TOD_UTILITIES.CONVERT_EXTERNAL_TOD_TO_INTERNAL_TOD( -- TOD_STRING=>TOD_String); -- ... -- end Convert_TOD_String_To_Ada_Predefined_Format; -- ... with Search_Utilities; -- generic searching package package body TOD_UTILITIES is -- the constants below make for easy conversion of -- CALENDAR.DAY_DURATION values. Noon_Hour : constant POSITIVE := 12; Number_of_Hours_in_Day : constant POSITIVE := 24; Number_of_Minutes_in_Hour : constant POSITIVE := 60; Number_of_Minutes_in_Day : constant POSITIVE := Number_of_Minutes_in_Hour * Number_of_Hours_in_Day; Number_of_Seconds_in_Minute : constant POSITIVE := 60; Number_of_Seconds_in_Hour : constant POSITIVE := Number_of_Seconds_in_Minute * Number_of_Minutes_in_Hour; Number_of_Seconds_in_Day : constant POSITIVE := Number_of_Seconds_in_Hour * Number_of_Hours_in_Day; Number_of_Days_in_a_Week : constant POSITIVE := 7; Number_of_Months_in_a_Year : constant POSITIVE := 12; -- constants needed to access the day name field of an external TOD -- representation Day_Name_Start : constant POSITIVE := 1; Day_Name_End : constant POSITIVE := 9; -- constants to make the code more readable Blank : constant CHARACTER := ' '; Colon : constant CHARACTER := ASCII.COLON; Period : constant CHARACTER := '.'; Max_Valid_Letter_Token_Length : constant POSITIVE := 9; UC_LC_Offset : constant NATURAL := CHARACTER'POS(ASCII.LC_A) - CHARACTER'POS('A'); -- types/subtypes and constant array needed by both functions subtype Set_of_Upper_Case_Letters is CHARACTER range 'A' .. 'Z'; subtype Search_Value_Type is STRING(1 .. Max_Valid_Letter_Token_Length); type Month_Name_Array_Type is array(INTEGER range <>) of Search_Value_Type; Month_Name_Array : constant Month_Name_Array_Type(CALENDAR.MONTH_NUMBER) := ("JANUARY ","FEBRUARY ","MARCH ","APRIL ","MAY ","JUNE ", "JULY ","AUGUST ","SEPTEMBER","OCTOBER ","NOVEMBER ","DECEMBER "); -- the function below uses an algorithm to derive the current day -- of the week given a date (in internal format) function Compute_Day_of_Week(TOD_VALUE : in CALENDAR.TIME) return Search_Value_Type is -- this function was designed by A. S. Peterson, LMSC according -- to the author's specifications. Only extremely minor changes -- were made to the algorithm by the author. -- the following constant hardcodes the algorithm to work at the -- reference point of 1984. Other hardcoded constants in the -- code nail the exact day, 1/1/84, to Sunday. If the reference -- point is changed, then so must the day names returned. Ref_Year : constant CALENDAR.YEAR_NUMBER := 1984; Number_of_Days_in_a_Leap_Year : constant POSITIVE := 366; Number_of_Days_in_a_Normal_Year : constant POSITIVE := 365; Number_of_Days_in_Feb_Leap_Year : constant POSITIVE := 29; Number_of_Days_in_Feb_Normal_Year : constant POSITIVE := 28; Number_of_Days_in_Long_Months : constant POSITIVE := 31; Number_of_Days_in_Short_Months : constant POSITIVE := 30; February : constant POSITIVE := 2; April : constant POSITIVE := 4; June : constant POSITIVE := 6; September : constant POSITIVE := 9; November : constant POSITIVE := 11; -- local types/subtypes follow below subtype Number_of_Days_Type is INTEGER range -Number_of_Days_in_a_Week + 1 .. Number_of_Days_in_a_Week - 1; -- local variables follow below First_Year, Last_Year, Input_Year : CALENDAR.YEAR_NUMBER; Month_Count, Input_Month : CALENDAR.MONTH_NUMBER; Input_Day : CALENDAR.DAY_NUMBER; Number_of_Days : INTEGER := 0; After_Ref_Year : BOOLEAN; Constrained_Num_Days : Number_of_Days_Type; -- local function follows below function Leap_Year(In_Year : in CALENDAR.YEAR_NUMBER) return BOOLEAN is Leap_Year_Century : constant POSITIVE := 400; Leap_Year_Offset : constant POSITIVE := 4; Century : constant POSITIVE := 100; begin if ((In_Year rem Leap_Year_Century) = 0) or (((In_Year rem Leap_Year_Offset) = 0) and ((In_Year rem Century) /= 0)) then return TRUE; -- the year specified is a leap year else return FALSE; -- the year specified is not a leap year end if; end Leap_Year; begin -- Compute_Day_of_Week -- decode the CALENDAR.TIME into its subcomponents Input_Year := CALENDAR.YEAR(TOD_VALUE); Input_Month := CALENDAR.MONTH(TOD_VALUE); Input_Day := CALENDAR.DAY(TOD_VALUE); -- start of the algorithm follows below if Input_Year < Ref_Year then After_Ref_Year := FALSE; First_Year := Input_Year; Last_Year := Ref_Year; else After_Ref_Year := TRUE; First_Year := Ref_Year; Last_Year := Input_Year; end if; while First_Year < Last_Year loop if Leap_Year(First_Year) then if After_Ref_Year then Number_of_Days := Number_of_Days + Number_of_Days_in_a_Leap_Year; else Number_of_Days := Number_of_Days - Number_of_Days_in_a_Leap_Year; end if; elsif After_Ref_Year then Number_of_Days := Number_of_Days + Number_of_Days_in_a_Normal_Year; else Number_of_Days := Number_of_Days - Number_of_Days_in_a_Normal_Year; end if; First_Year := First_Year + 1; end loop; Month_Count := 1; while Month_Count < Input_Month loop case Month_Count is when February => if Leap_Year(Input_Year) then Number_of_Days := Number_of_Days + Number_of_Days_in_Feb_Leap_Year; else Number_of_Days := Number_of_Days + Number_of_Days_in_Feb_Normal_Year; end if; when April | June | September | November => Number_of_Days := Number_of_Days + Number_of_Days_in_Short_Months; when others => Number_of_Days := Number_of_Days + Number_of_Days_in_Long_Months; end case; Month_Count := Month_Count + 1; end loop; Constrained_Num_Days := (Number_of_Days + Input_Day) rem Number_of_Days_in_a_Week; case Constrained_Num_Days is when -6 => return "SUNDAY "; when -5 => return "MONDAY "; when -4 => return "TUESDAY "; when -3 => return "WEDNESDAY"; when -2 => return "THURSDAY "; when -1 => return "FRIDAY "; when 0 => return "SATURDAY "; when 1 => return "SUNDAY "; -- algorithm hardcoded on this day when 2 => return "MONDAY "; when 3 => return "TUESDAY "; when 4 => return "WEDNESDAY"; when 5 => return "THURSDAY "; when 6 => return "FRIDAY "; end case; end Compute_Day_of_Week; -- the function below converts an internal CALENDAR.TIME value to -- an external STRING value function CONVERT_INTERNAL_TOD_TO_EXTERNAL_TOD( TOD_VALUE : in CALENDAR.TIME; DEFAULT_SETTING : in TYPE_SET := UPPER_CASE) return EXTERNAL_TOD_REPRESENTATION_TYPE is -- constants for array positions of each component of the external -- representation type follow below Day_Number_Start : constant POSITIVE := 11; Day_Number_End : constant POSITIVE := 12; Month_Name_Start : constant POSITIVE := 14; Month_Name_End : constant POSITIVE := 22; Year_Number_Start : constant POSITIVE := 24; Year_Number_End : constant POSITIVE := 27; Time_Start : constant POSITIVE := 29; Time_End : constant POSITIVE := 38; Hour_Start : constant POSITIVE := 29; Hour_End : constant POSITIVE := 30; Minute_Start : constant POSITIVE := 32; Minute_End : constant POSITIVE := 33; Second_Start : constant POSITIVE := 35; Second_End : constant POSITIVE := 36; AMPM_Start : constant POSITIVE := 37; AMPM_End : constant POSITIVE := 38; -- constants to make the code more readable Leading_Zero : constant CHARACTER := '0'; -- local type/subtype declarations follow below subtype Double_Digits is NATURAL range 10 .. NATURAL'LAST; subtype Afternoon_or_Evening is NATURAL range Noon_Hour .. Number_of_Hours_in_Day - 1; -- local variables follow below Year : CALENDAR.YEAR_NUMBER; Month : CALENDAR.MONTH_NUMBER; Day : CALENDAR.DAY_NUMBER; Seconds : CALENDAR.DAY_DURATION; Curr_Hour : NATURAL range 00 .. Number_of_Hours_in_Day; Curr_Minute : NATURAL range 00 .. Number_of_Minutes_in_Hour - 1; Curr_Second : NATURAL range 00 .. Number_of_Seconds_in_Minute - 1; Seconds_as_Natural : NATURAL range 0 .. Number_of_Seconds_in_Day; Temp_Value, Return_Value : EXTERNAL_TOD_REPRESENTATION_TYPE := (others => Blank); -- local procs follow below procedure Convert_Upper_Case_to_Lower_Case(TOD_Value : in out STRING) is begin for I in TOD_Value'RANGE loop if TOD_Value(I) in Set_of_Upper_Case_Letters then TOD_Value(I) := CHARACTER'VAL(CHARACTER'POS(TOD_Value(I)) + UC_LC_Offset); end if; end loop; end Convert_Upper_Case_to_Lower_Case; procedure Convert_Upper_Case_to_Mixed_Case(TOD_Value : in out STRING) is begin for I in TOD_Value'FIRST + 1 .. TOD_Value'LAST loop if (TOD_Value(I) in Set_of_Upper_Case_Letters) and (TOD_Value(I-1) /= Blank) then TOD_Value(I) := CHARACTER'VAL(CHARACTER'POS(TOD_Value(I)) + UC_LC_Offset); end if; end loop; -- special case: AM/PM indicator. TOD_Value(AMPM_Start) := CHARACTER'VAL(CHARACTER'POS(TOD_Value(AMPM_Start)) - UC_LC_Offset); end Convert_Upper_Case_to_Mixed_Case; -- the body of CONVERT_INTERNAL_TOD_TO_EXTERNAL_TOD follows below begin -- store day of the week string Return_Value(Day_Name_Start .. Day_Name_End) := Compute_Day_of_Week(TOD_VALUE); -- disect internal format into its components for our own use CALENDAR.SPLIT(TOD_VALUE,Year,Month,Day,Seconds); -- store day number value if Day in Double_Digits then Temp_Value(Day_Number_Start - 1 .. Day_Number_End) := CALENDAR.DAY_NUMBER'IMAGE(Day); Return_Value(Day_Number_Start .. Day_Number_End) := Temp_Value(Day_Number_Start .. Day_Number_End); else Temp_Value(Day_Number_End - 1 .. Day_Number_End) := CALENDAR.DAY_NUMBER'IMAGE(Day); Return_Value(Day_Number_Start) := '0'; Return_Value(Day_Number_End) := Temp_Value(Day_Number_End); end if; -- store the month name and year number Return_Value(Month_Name_Start .. Month_Name_End) := Month_Name_Array(Month); Temp_Value(Year_Number_Start - 1 .. Year_Number_End) := CALENDAR.YEAR_NUMBER'IMAGE(Year); Return_Value(Year_Number_Start .. Year_Number_End) := Temp_Value(Year_Number_Start .. Year_Number_End); -- convert CALENDAR.DAY_DURATION value to NATURAL for easier -- calculations below Seconds_as_Natural := NATURAL(Seconds); -- compute the current hour, minutes, and seconds Curr_Hour := (Seconds_as_Natural / Number_of_Minutes_in_Hour) / Number_of_Seconds_in_Minute; Curr_Minute := (Seconds_as_Natural / Number_of_Minutes_in_Hour) mod Number_of_Seconds_in_Minute; Curr_Second := Seconds_as_Natural - (Curr_Hour * Number_of_Seconds_in_Hour) - (Curr_Minute * Number_of_Minutes_in_Hour); -- check for AM/PM in current hour and store AM/PM indication if (Curr_Hour = 00) or (Curr_Hour = Number_of_Hours_in_Day) then Curr_Hour := Noon_Hour; -- 00:00:00 === 12:00:00 AM === 24:00:00 Return_Value(AMPM_Start .. AMPM_End) := "AM"; elsif (Curr_Hour in Afternoon_or_Evening) and (Curr_Hour /= Noon_Hour) then Curr_Hour := Curr_Hour - Noon_Hour; -- convert to AM/PM format Return_Value(AMPM_Start .. AMPM_End) := "PM"; elsif Curr_Hour = Noon_Hour then Return_Value(AMPM_Start .. AMPM_End) := "PM"; else Return_Value(AMPM_Start .. AMPM_End) := "AM"; end if; -- store current hour if Curr_Hour in Double_Digits then Temp_Value(Hour_Start - 1 .. Hour_End) := NATURAL'IMAGE(Curr_Hour); Return_Value(Hour_Start .. Hour_End) := Temp_Value(Hour_Start .. Hour_End); else Temp_Value(Hour_End - 1 .. Hour_End) := NATURAL'IMAGE(Curr_Hour); Return_Value(Hour_Start) := Leading_Zero; Return_Value(Hour_End) := Temp_Value(Hour_End); end if; Return_Value(Hour_End + 1) := Colon; -- store current minutes if Curr_Minute in Double_Digits then Temp_Value(Minute_Start - 1 .. Minute_End) := NATURAL'IMAGE(Curr_Minute); Return_Value(Minute_Start .. Minute_End) := Temp_Value(Minute_Start .. Minute_End); else Temp_Value(Minute_End - 1 .. Minute_End) := NATURAL'IMAGE(Curr_Minute); Return_Value(Minute_Start) := Leading_Zero; Return_Value(Minute_End) := Temp_Value(Minute_End); end if; Return_Value(Minute_End + 1) := Colon; -- store current seconds if Curr_Second in Double_Digits then Temp_Value(Second_Start - 1 .. Second_End) := NATURAL'IMAGE(Curr_Second); Return_Value(Second_Start .. Second_End) := Temp_Value(Second_Start .. Second_End); else Temp_Value(Second_End - 1 .. Second_End) := NATURAL'IMAGE(Curr_Second); Return_Value(Second_Start) := Leading_Zero; Return_Value(Second_End) := Temp_Value(Second_End); end if; -- set non-default type set for the user? if DEFAULT_SETTING = lower_case then Convert_Upper_Case_to_Lower_Case(Return_Value); elsif DEFAULT_SETTING = Mixed_Case then Convert_Upper_Case_to_Mixed_Case(Return_Value); end if; -- we are done. Return the external format to the user. return Return_Value; end CONVERT_INTERNAL_TOD_TO_EXTERNAL_TOD; -- the function below converts an external format TOD to the Ada -- internal format, CALENDAR.TIME . function CONVERT_EXTERNAL_TOD_TO_INTERNAL_TOD( TOD_STRING : in STRING) return CALENDAR.TIME is -- local constants follow below Comma : constant CHARACTER := ','; Minus : constant CHARACTER := '-'; Slash : constant CHARACTER := '/'; Current_Time : constant CALENDAR.TIME := CALENDAR.CLOCK; Minimum_TOD_STRING_Length : constant POSITIVE := 2; -- local types/subtypes follow below subtype TOD_Value_Length_Type is NATURAL range 0 .. TOD_STRING'LAST - TOD_STRING'FIRST + 1; subtype TOD_Value_Pointer_Type is POSITIVE range TOD_STRING'FIRST .. TOD_STRING'LAST + 1; type Token_Type is (Day_as_Name,Day_as_Number,Month_Name_or_Number, Year_Number,Time_String,Special_Format); type Tokens_Specified_Array_Type is array(Token_Type) of BOOLEAN; -- local variables follow below TOD_Value : STRING(TOD_STRING'FIRST .. TOD_STRING'LAST) := TOD_STRING; TOD_Value_Compressed_Length, Token_Length : TOD_Value_Length_Type; TOD_Value_Pointer : TOD_Value_Pointer_Type := TOD_Value'FIRST; Token : STRING(TOD_Value'RANGE); Year : CALENDAR.YEAR_NUMBER := CALENDAR.YEAR(Current_Time); Month : CALENDAR.MONTH_NUMBER := CALENDAR.MONTH(Current_Time); Day : CALENDAR.DAY_NUMBER := CALENDAR.DAY(Current_Time); Seconds : CALENDAR.DAY_DURATION := CALENDAR.DAY_DURATION'FIRST; Day_Name : Search_Value_Type; No_Token_Found : BOOLEAN; Return_Time_Value : CALENDAR.TIME := CALENDAR.TIME_OF(Year,Month,Day,CALENDAR.DAY_DURATION'FIRST); Tokens_Specified_Array : Tokens_Specified_Array_Type := (others => FALSE); -- local procs/funcs follow below function "+"(Left : CALENDAR.TIME; Right : DURATION) return CALENDAR.TIME renames CALENDAR."+"; function "-"(Left : CALENDAR.TIME; Right : DURATION) return CALENDAR.TIME renames CALENDAR."-"; procedure Compress_External_Representation( TOD_Value : in out STRING; TOD_Value_Compressed_Length : out TOD_Value_Length_Type) is -- local variables follow below TOD_Value_Copy : STRING(TOD_Value'RANGE) := (others => Blank); TOD_Value_Pointer, TOD_Value_Pointer_Copy : TOD_Value_Pointer_Type := TOD_Value'FIRST; begin -- change all commas to blanks and all minus signs to slash -- signs for easier parsing for I in TOD_Value'RANGE loop if TOD_Value(I) = Comma then TOD_Value(I) := Blank; elsif TOD_Value(I) = Minus then TOD_Value(I) := Slash; end if; end loop; -- skip over leading blanks while (TOD_Value_Pointer <= TOD_Value'LAST) and then (TOD_Value(TOD_Value_Pointer) = Blank) loop TOD_Value_Pointer := TOD_Value_Pointer + 1; end loop; -- skip over excessive number of blanks in the middle of -- the string. while (TOD_Value_Pointer <= TOD_Value'LAST - 2) loop if (TOD_Value(TOD_Value_Pointer) = Blank) and (TOD_Value(TOD_Value_Pointer + 1) = Blank) and (TOD_Value(TOD_Value_Pointer + 2) = Blank) then TOD_Value_Pointer := TOD_Value_Pointer + 2; elsif (TOD_Value(TOD_Value_Pointer) = Blank) and (TOD_Value(TOD_Value_Pointer + 1) = Blank) then TOD_Value_Pointer := TOD_Value_Pointer + 2; TOD_Value_Pointer_Copy := TOD_Value_Pointer_Copy + 1; elsif (TOD_Value(TOD_Value_Pointer) = Blank) then TOD_Value_Pointer := TOD_Value_Pointer + 1; TOD_Value_Pointer_Copy := TOD_Value_Pointer_Copy + 1; else TOD_Value_Copy(TOD_Value_Pointer_Copy) := TOD_Value(TOD_Value_Pointer); TOD_Value_Pointer := TOD_Value_Pointer + 1; TOD_Value_Pointer_Copy := TOD_Value_Pointer_Copy + 1; end if; end loop; -- now handle special cases near the end of the string if (TOD_Value'FIRST + TOD_Value'LAST - 1 >= 3) and then ((TOD_Value(TOD_Value'LAST - 2) /= Blank) and (TOD_Value(TOD_Value'LAST - 1) = Blank) and (TOD_Value(TOD_Value'LAST) /= Blank) ) then TOD_Value_Pointer_Copy := TOD_Value_Pointer_Copy + 1; end if; if (TOD_Value'FIRST + TOD_Value'LAST - 1 >= 2) and then (TOD_Value(TOD_Value'LAST - 1) /= Blank) then TOD_Value_Copy(TOD_Value_Pointer_Copy) := TOD_Value(TOD_Value'LAST - 1); TOD_Value_Pointer_Copy := TOD_Value_Pointer_Copy + 1; end if; if (TOD_Value'FIRST + TOD_Value'LAST - 1 >= 1) and then (TOD_Value(TOD_Value'LAST) /= Blank) then TOD_Value_Copy(TOD_Value_Pointer_Copy) := TOD_Value(TOD_Value'LAST); TOD_Value_Pointer_Copy := TOD_Value_Pointer_Copy + 1; end if; -- now return the compressed string and corresponding length TOD_Value := TOD_Value_Copy; TOD_Value_Compressed_Length := TOD_Value_Pointer_Copy - TOD_Value'FIRST; end Compress_External_Representation; procedure Convert_External_Representation_to_Upper_Case(TOD_Value : in out STRING) is subtype Set_of_Lower_Case_Letters is CHARACTER range ASCII.LC_A .. ASCII.LC_Z; begin -- loop on all characters in the compressed TOD_Value. Modify -- all lower case letters to upper case. for I in TOD_Value'FIRST .. TOD_Value'FIRST + TOD_Value_Compressed_Length - 1 loop if TOD_Value(I) in Set_of_Lower_Case_Letters then TOD_Value(I) := CHARACTER'VAL(CHARACTER'POS(TOD_Value(I)) - UC_LC_Offset); end if; end loop; end Convert_External_Representation_to_Upper_Case; procedure Grab_a_Token( TOD_Value : in STRING; TOD_Value_Pointer : in out TOD_Value_Pointer_Type; Token : out STRING; Token_Length : out TOD_Value_Length_Type; No_Token_Found : out BOOLEAN) is -- local variables follow below Local_Token : STRING(Token'RANGE) := (others => Blank); Token_Pointer : TOD_Value_Pointer_Type := Local_Token'FIRST; begin -- grab the next token while (TOD_Value_Pointer <= TOD_Value_Compressed_Length + TOD_Value'FIRST - 1) and then (TOD_Value(TOD_Value_Pointer) /= Blank) loop Local_Token(Token_Pointer) := TOD_Value(TOD_Value_Pointer); Token_Pointer := Token_Pointer + 1; TOD_Value_Pointer := TOD_Value_Pointer + 1; end loop; -- skip over that blank, but don't skip outside the bounds if TOD_Value_Pointer < TOD_Value_Pointer_Type'LAST then TOD_Value_Pointer := TOD_Value_Pointer + 1; end if; -- did we find a token? Return T/F. Also return the token and length No_Token_Found := (Local_Token(Local_Token'FIRST) = Blank); Token := Local_Token; Token_Length := Token_Pointer - Local_Token'FIRST; end Grab_a_Token; procedure Analyze_and_Process_Token( Token : in STRING; Token_Length : in TOD_Value_Length_Type; Month_Only : in BOOLEAN) is Current_Century : constant POSITIVE := (CALENDAR.YEAR(Current_Time) / 100) * 100; subtype Short_Year_Range is NATURAL range 0 .. 99; subtype Set_of_Numerics is CHARACTER range '0' .. '9'; --local procs/funcs follow below function Token_Contains_Illegal_Characters( Token : in STRING; Token_Length : in TOD_Value_Length_Type) return BOOLEAN is Only_Legals : BOOLEAN := TRUE; -- assume the best begin -- short-circuits below used for speed for I in Token'FIRST .. Token'FIRST + Token_Length - 1 loop Only_Legals := Only_Legals and then ((Token(I) in Set_of_Upper_Case_Letters) or else (Token(I) in Set_of_Numerics) or else (Token(I) = Colon) or else (Token(I) = Period) or else (Token(I) = Slash)); end loop; return (not Only_Legals); end Token_Contains_Illegal_Characters; function Token_Contains_Only_Letters( Token : in STRING; Token_Length : in TOD_Value_Length_Type) return BOOLEAN is Only_Letters : BOOLEAN := TRUE; -- assume the best begin for I in Token'FIRST .. Token'FIRST + Token_Length - 1 loop -- check for a period in an abbreviation. The period can only -- appear as the last character on the token, otherwise the -- token is invalid. if ((Token(I) = Period) and (I /= Token'FIRST + Token_Length - 1)) and then Token(I+1) /= Slash then raise ABBREVIATION_ERROR; end if; -- now check to make sure that the current character being -- checked is a letter. (short-circuits below used for speed.) Only_Letters := Only_Letters and then ((Token(I) in Set_of_Upper_Case_Letters) or else (Token(I) = Period)); end loop; return Only_Letters; end Token_Contains_Only_Letters; function Token_Contains_No_Letters( Token : in STRING; Token_Length : in TOD_Value_Length_Type) return BOOLEAN is No_Letters : BOOLEAN := TRUE; -- assume the best begin -- short-circuit below used for speed for I in Token'FIRST .. Token'FIRST + Token_Length - 1 loop No_Letters := No_Letters and then (not (Token(I) in Set_of_Upper_Case_Letters)); end loop; return No_Letters; end Token_Contains_No_Letters; function Token_Contains_Only_Numerics( Token : in STRING; Token_Length : in TOD_Value_Length_Type) return BOOLEAN is Only_Numerics : BOOLEAN := TRUE; -- assume the best begin -- short-circuit below used for speed for I in Token'FIRST .. Token'FIRST + Token_Length - 1 loop Only_Numerics := Only_Numerics and then (Token(I) in Set_of_Numerics); end loop; return Only_Numerics; end Token_Contains_Only_Numerics; function Token_Contains_Slash( Token : in STRING; Token_Length : in TOD_Value_Length_Type) return BOOLEAN is Slash_Found : BOOLEAN := FALSE; -- assume the worst begin -- short-circuit below used for speed for I in Token'FIRST .. Token'FIRST + Token_Length - 1 loop Slash_Found := Slash_Found or else (Token(I) = Slash); end loop; return Slash_Found; end Token_Contains_Slash; function Token_Contains_Colon_and_Numerics_with_Optional_AMPM( Token : in STRING; Token_Length : in TOD_Value_Length_Type) return BOOLEAN is Colon_Found : BOOLEAN := FALSE; -- assume the worst Valid_Token : BOOLEAN := TRUE; -- assume the best begin -- short-circuits below used for speed for I in Token'FIRST .. Token'FIRST + Token_Length - 3 loop if Token(I) /= Colon then Valid_Token := Valid_Token and then (Token(I) in Set_of_Numerics); else Colon_Found := TRUE; end if; end loop; if Token_Length < 3 then Valid_Token := FALSE; elsif (Token(Token'FIRST + Token_Length - 2 .. Token'FIRST + Token_Length - 1) /= "AM") and then (Token(Token'FIRST + Token_Length - 2 .. Token'FIRST + Token_Length - 1) /= "PM") then Valid_Token := Valid_Token and then (Token(Token'FIRST + Token_Length - 2) in Set_of_Numerics); Valid_Token := Valid_Token and then (Token(Token'FIRST + Token_Length - 1) in Set_of_Numerics); end if; return Valid_Token and then Colon_Found; end Token_Contains_Colon_and_Numerics_with_Optional_AMPM; function Token_Contains_Numerics_and_AMPM( Token : in STRING; Token_Length : in TOD_Value_Length_Type) return BOOLEAN is Valid_Token : BOOLEAN := TRUE; -- assume the best begin -- short-circuits below used for speed for I in Token'FIRST .. Token'FIRST + Token_Length - 3 loop Valid_Token := Valid_Token and then (Token(I) in Set_of_Numerics); end loop; if (Token(Token'FIRST + Token_Length - 2 .. Token'FIRST + Token_Length - 1) /= "AM") and then (Token(Token'FIRST + Token_Length - 2 .. Token'FIRST + Token_Length - 1) /= "PM") then Valid_Token := FALSE; end if; return Valid_Token; end Token_Contains_Numerics_and_AMPM; function Convert_Token_to_Proper_Length(Token : in STRING) return Search_Value_Type is Token_Copy : Search_Value_Type := (others => blank); I : POSITIVE range Token'FIRST .. Token'FIRST + Max_Valid_Letter_Token_Length := Token'FIRST; begin -- short-circuit below used for speed while (I <= Token'FIRST + Max_Valid_Letter_Token_Length - 1) and then (I <= Token'LAST) loop Token_Copy(I) := Token(I); I := I + 1; end loop; return Token_Copy; end Convert_Token_to_Proper_Length; procedure Analyze_and_Process_Day_Name_or_Month_Name_or_Special( Token : in STRING; Token_Length : in TOD_Value_Length_Type; Month_Only : in BOOLEAN) is Local_Token : Search_Value_Type := Convert_Token_to_Proper_Length(Token); Local_Token_Length : TOD_Value_Length_Type := Token_Length; Location_Found : POSITIVE; Component_Found, Abbreviation_Specified : BOOLEAN; -- establish the arrays of possible days, months, and special -- components Number_of_Day_Match_Components : constant POSITIVE := 43; Number_of_Month_Match_Components : constant POSITIVE := 50; Number_of_Special_Components : constant POSITIVE := 4; type My_Array_Type is array(POSITIVE range <>) of Search_Value_Type; subtype Day_Match_Array_Index_Type is POSITIVE range 1 .. Number_of_Day_Match_Components; subtype Month_Match_Array_Index_Type is POSITIVE range 1 .. Number_of_Month_Match_Components; subtype Specials_Array_Index_Type is POSITIVE range 1 .. Number_of_Special_Components; Day_Match_Array : constant My_Array_Type(Day_Match_Array_Index_Type) := ("SU ","SUN ","SUND ","SUNDA ","SUNDAY ", "MO ","MON ","MOND ","MONDA ","MONDAY ", "TU ","TUE ","TUES ","TUESD ","TUESDA ","TUESDAY ", "WE ","WED ","WEDN ","WEDNE ","WEDNES ","WEDNESD ","WEDNESDA ","WEDNESDAY", "TH ","THU ","THUR ","THURS ","THURSD ","THURSDA ","THURSDAY ", "FR ","FRI ","FRID ","FRIDA ","FRIDAY ", "SA ","SAT ","SATU ","SATUR ","SATURD ","SATURDA ","SATURDAY "); Month_Match_Array : constant My_Array_Type(Month_Match_Array_Index_Type) := ("JAN ","JANU ","JANUA ","JANUAR ","JANUARY ", "FEB ","FEBR ","FEBRU ","FEBRUA ","FEBRUAR ","FEBRUARY ", "MAR ","MARC ","MARCH ", "APR ","APRI ","APRIL ", "MAY ", "JUN ","JUNE ", "JUL ","JULY ", "AUG ","AUGU ","AUGUS ","AUGUST ", "SEP ","SEPT ","SEPTE ","SEPTEM ","SEPTEMB ","SEPTEMBE ","SEPTEMBER", "OCT ","OCTO ","OCTOB ","OCTOBE ","OCTOBER ", "NOV ","NOVE ","NOVEM ","NOVEMB ","NOVEMBE ","NOVEMBER ", "DEC ","DECE ","DECEM ","DECEMB ","DECEMBE ","DECEMBER "); Su_First : constant POSITIVE := 1; Jan_First : constant POSITIVE := 1; Su_Last : constant POSITIVE := 5; Jan_Last : constant POSITIVE := 5; Mo_First : constant POSITIVE := 6; Feb_First : constant POSITIVE := 6; Mo_Last : constant POSITIVE := 10; Feb_Last : constant POSITIVE := 11; Tu_First : constant POSITIVE := 11; Mar_First : constant POSITIVE := 12; Tu_Last : constant POSITIVE := 16; Mar_Last : constant POSITIVE := 14; We_First : constant POSITIVE := 17; Apr_First : constant POSITIVE := 15; We_Last : constant POSITIVE := 24; Apr_Last : constant POSITIVE := 17; Th_First : constant POSITIVE := 25; May_First : constant POSITIVE := 18; Th_Last : constant POSITIVE := 31; May_Last : constant POSITIVE := 18; Fr_First : constant POSITIVE := 32; Jun_First : constant POSITIVE := 19; Fr_Last : constant POSITIVE := 36; Jun_Last : constant POSITIVE := 20; Sa_First : constant POSITIVE := 37; Jul_First : constant POSITIVE := 21; Sa_Last : constant POSITIVE := 43; Jul_Last : constant POSITIVE := 22; Aug_First : constant POSITIVE := 23; Aug_Last : constant POSITIVE := 26; Sep_First : constant POSITIVE := 27; Sep_Last : constant POSITIVE := 33; Oct_First : constant POSITIVE := 34; Oct_Last : constant POSITIVE := 38; Nov_First : constant POSITIVE := 39; Nov_Last : constant POSITIVE := 44; Dec_First : constant POSITIVE := 45; Dec_Last : constant POSITIVE := 50; Specials_Array : constant My_Array_Type(Specials_Array_Index_Type) := ("NOW ","TODAY ","TOMORROW ","YESTERDAY"); -- establish an instantiation of the generic search package package Search_For_Month_or_Day_Name_or_Specials is new Search_Utilities( Component_Type => Search_Value_Type, Index_Type => POSITIVE, Array_Type => My_Array_Type); -- local procedures folows below procedure Analyze_and_Process_Day_Name( Token : in STRING; Location_Found : in Day_Match_Array_Index_Type; Abbreviation_Specified : in BOOLEAN) is begin -- check to see if the day name has already been specified if Tokens_Specified_Array(Day_as_Name) then raise DUPLICATION_ERROR; end if; Tokens_Specified_Array(Day_as_Name) := TRUE; -- now check to make sure that a period did not follow a full name if Abbreviation_Specified then declare type Array_Type is array(POSITIVE range <>) of Search_Value_Type; Days_Array : constant Array_Type(1 .. Number_of_Days_in_a_Week) := ("SUNDAY ","MONDAY ","TUESDAY ","WEDNESDAY","THURSDAY ","FRIDAY ","SATURDAY "); package Search_For_Full_Day_Name is new Search_Utilities( Component_Type => Search_Value_Type, Index_Type => POSITIVE, Array_Type => Array_Type); begin if Search_For_Full_Day_Name.SEARCH( Component => Token, Search_Array => Days_Array) then raise ABBREVIATION_ERROR; end if; end; -- local declare block end if; -- now store the day name for future processing case Location_Found is when Su_First .. Su_Last => Day_Name := "SUNDAY "; when Mo_First .. Mo_Last => Day_Name := "MONDAY "; when Tu_First .. Tu_Last => Day_Name := "TUESDAY "; when We_First .. We_Last => Day_Name := "WEDNESDAY"; when Th_First .. Th_Last => Day_Name := "THURSDAY "; when Fr_First .. Fr_Last => Day_Name := "FRIDAY "; when Sa_First .. Sa_Last => Day_Name := "SATURDAY "; end case; end Analyze_and_Process_Day_Name; procedure Analyze_and_Process_Month_Name( Token : in STRING; Location_Found : in Month_Match_Array_Index_Type; Abbreviation_Specified : in BOOLEAN) is begin -- check to see if the month name has already been specified if Tokens_Specified_Array(Month_Name_or_Number) then raise DUPLICATION_ERROR; end if; Tokens_Specified_Array(Month_Name_or_Number) := TRUE; -- now check to make sure that a period did not follow a full name if Abbreviation_Specified then declare package Search_For_Full_Month_Name is new Search_Utilities( Component_Type => Search_Value_Type, Index_Type => INTEGER, Array_Type => Month_Name_Array_Type); begin if Search_For_Full_Month_Name.SEARCH( Component => Token, Search_Array => Month_Name_Array) then raise ABBREVIATION_ERROR; end if; end; -- local declare block end if; -- now store the month number case Location_Found is when Jan_First .. Jan_Last => Month := 1; when Feb_First .. Feb_Last => Month := 2; when Mar_First .. Mar_Last => Month := 3; when Apr_First .. Apr_Last => Month := 4; when May_First .. May_Last => Month := 5; when Jun_First .. Jun_Last => Month := 6; when Jul_First .. Jul_Last => Month := 7; when Aug_First .. Aug_Last => Month := 8; when Sep_First .. Sep_Last => Month := 9; when Oct_First .. Oct_Last => Month := 10; when Nov_First .. Nov_Last => Month := 11; when Dec_First .. Dec_Last => Month := 12; end case; end Analyze_and_Process_Month_Name; procedure Analyze_and_Process_Special( Token : in STRING; Abbreviation_Specified : in BOOLEAN) is begin -- check to see if the special element has already been -- specified or if an illegal period was specified if Tokens_Specified_Array(Special_Format) then raise DUPLICATION_ERROR; elsif Abbreviation_Specified then raise ABBREVIATION_ERROR; end if; Tokens_Specified_Array(Special_Format) := TRUE; if Token(Token'FIRST..Token'FIRST + Max_Valid_Letter_Token_Length - 1) = "NOW " then Return_Time_Value := CALENDAR.CLOCK; elsif Token(Token'FIRST..Token'FIRST + Max_Valid_Letter_Token_Length - 1) = "YESTERDAY" then Return_Time_Value := CALENDAR.TIME_OF(Year,Month,Day,Seconds) - CALENDAR.DAY_DURATION'LAST; elsif Token(Token'FIRST..Token'FIRST + Max_Valid_Letter_Token_Length - 1) = "TOMORROW " then Return_Time_Value := CALENDAR.TIME_OF(Year,Month,Day,Seconds) + CALENDAR.DAY_DURATION'LAST; end if; -- now store the components of this internal format so that -- they may be used later. Year := CALENDAR.YEAR(Return_Time_Value); Month := CALENDAR.MONTH(Return_Time_Value); Day := CALENDAR.DAY(Return_Time_Value); end Analyze_and_Process_Special; -- body of Analyze_and_Process_Day_Name_or_Month_Name_or_Special follows below begin -- check for invalid tokens that are too long if Token_Length > Max_Valid_Letter_Token_Length then raise EXTERNAL_REPRESENTATION_ERROR; end if; -- check to see if an abbreviation has been given if Local_Token(Local_Token'FIRST + Token_Length - 1) /= Period then Abbreviation_Specified := FALSE; else Local_Token(Local_Token'FIRST + Local_Token_Length - 1) := Blank; Local_Token_Length := Local_Token_Length - 1; Abbreviation_Specified := TRUE; end if; -- search the array of day names Search_For_Month_or_Day_Name_or_Specials.SEARCH( Component => Local_Token, Search_Array => Day_Match_Array, Location_Found => Location_Found, Component_Found => Component_Found); if Component_Found and (not Month_Only) then Analyze_and_Process_Day_Name(Local_Token,Location_Found,Abbreviation_Specified); else -- search the array of month names Search_For_Month_or_Day_Name_or_Specials.SEARCH( Component => Local_Token, Search_Array => Month_Match_Array, Location_Found => Location_Found, Component_Found => Component_Found); if Component_Found then Analyze_and_Process_Month_Name(Local_Token,Location_Found,Abbreviation_Specified); else -- search the array of special formats Search_For_Month_or_Day_Name_or_Specials.SEARCH( Component => Local_Token, Search_Array => Specials_Array, Location_Found => Location_Found, Component_Found => Component_Found); if Component_Found and not Month_Only then Analyze_and_Process_Special(Local_Token,Abbreviation_Specified); else raise EXTERNAL_REPRESENTATION_ERROR; end if; end if; end if; end Analyze_and_Process_Day_Name_or_Month_Name_or_Special; procedure Analyze_and_Process_Day_Number_or_Year_Number( Token : in STRING; Token_Length : in TOD_Value_Length_Type) is Temp_Value : NATURAL := NATURAL'VALUE(Token); begin -- is the number valid? If so, store the year/day. if not (Temp_Value in Short_Year_Range) and not (Temp_Value in CALENDAR.YEAR_NUMBER) then raise EXTERNAL_REPRESENTATION_ERROR; end if; if Temp_Value in CALENDAR.YEAR_NUMBER then if Tokens_Specified_Array(Year_Number) then raise DUPLICATION_ERROR; elsif (Tokens_Specified_Array(Month_Name_or_Number) and (not Tokens_Specified_Array(Day_as_Number)) ) or (Tokens_Specified_Array(Day_as_Number) and (not Tokens_Specified_Array(Month_Name_or_Number)) ) then raise EXTERNAL_REPRESENTATION_ERROR; end if; Tokens_Specified_Array(Year_Number) := TRUE; Year := Temp_Value; elsif (not Tokens_Specified_Array(Day_as_Number)) and (Temp_Value in CALENDAR.DAY_NUMBER) then Tokens_Specified_Array(Day_as_Number) := TRUE; Day := Temp_Value; elsif Tokens_Specified_Array(Year_Number) or (not Tokens_Specified_Array(Month_Name_or_Number)) or (not Tokens_Specified_Array(Day_as_Number)) then raise EXTERNAL_REPRESENTATION_ERROR; else Tokens_Specified_Array(Year_Number) := TRUE; -- special current century check: 00 = 2000 (20th century) if (Temp_Value = 00) and (Current_Century = 1900) then Year := 2000; else Year := Current_Century + Temp_Value; end if; end if; end Analyze_and_Process_Day_Number_or_Year_Number; procedure Analyze_and_Process_Date( Token : in STRING; Token_Length : in TOD_Value_Length_Type) is -- local procs follow below procedure Analyze_and_Process_Numeric_Date( Token : in STRING; Token_Length : in TOD_Value_Length_Type) is Curr_Month, Curr_Day, Curr_Year : NATURAL; Temp_String : STRING(Token'FIRST .. Token'LAST) := (others => Blank); Temp_String_Pointer, Token_Pointer : TOD_Value_Pointer_Type := Token'FIRST; begin if Tokens_Specified_Array(Month_Name_or_Number) then raise DUPLICATION_ERROR; end if; Tokens_Specified_Array(Month_Name_or_Number) := TRUE; -- grab the month. We should only find 1 or 2 characters. while (Token_Pointer <= Token'FIRST + Token_Length - 1) and then (Token(Token_Pointer) /= Slash) loop Temp_String(Temp_String_Pointer) := Token(Token_Pointer); Token_Pointer := Token_Pointer + 1; Temp_String_Pointer := Temp_String_Pointer + 1; end loop; if (Temp_String_Pointer > Temp_String'FIRST + 2) or (Temp_String_Pointer = Temp_String'FIRST) then raise MONTH_NUMBER_ERROR; end if; -- store the month and check its range Curr_Month := NATURAL'VALUE(Temp_String); if not (Curr_Month in CALENDAR.MONTH_NUMBER) then raise MONTH_NUMBER_ERROR; else Month := Curr_Month; end if; if Tokens_Specified_Array(Day_as_Number) then raise DUPLICATION_ERROR; end if; Tokens_Specified_Array(Day_as_Number) := TRUE; -- grab the day. Procedure is the same as above. Token_Pointer := Token_Pointer + 1; -- bumb past slash Temp_String := (others => Blank); Temp_String_Pointer := Temp_String'FIRST; while (Token_Pointer <= Token'FIRST + Token_Length - 1) and then (Token(Token_Pointer) /= Slash) loop Temp_String(Temp_String_Pointer) := Token(Token_Pointer); Token_Pointer := Token_Pointer + 1; Temp_String_Pointer := Temp_String_Pointer + 1; end loop; if (Temp_String_Pointer > Temp_String'FIRST + 2) or (Temp_String_Pointer = Temp_String'FIRST) then raise DAY_NUMBER_ERROR; end if; -- store the day and check its range Curr_Day := NATURAL'VALUE(Temp_String); if not (Curr_Day in CALENDAR.DAY_NUMBER) then raise DAY_NUMBER_ERROR; else Day := Curr_Day; end if; -- grab the year. Procedure is the same as above. -- year is optional, so check for this first. if (Token_Pointer <= Token'FIRST + Token_Length - 1) and then (Token(Token_Pointer) = Slash) then if Tokens_Specified_Array(Year_Number) then raise DUPLICATION_ERROR; end if; Tokens_Specified_Array(Year_Number) := TRUE; Token_Pointer := Token_Pointer + 1; Temp_String := (others => Blank); Temp_String_Pointer := Temp_String'FIRST; while (Token_Pointer <= Token'FIRST + Token_Length - 1) and then (Token(Token_Pointer) /= Slash) loop Temp_String(Temp_String_Pointer) := Token(Token_Pointer); Token_Pointer := Token_Pointer + 1; Temp_String_Pointer := Temp_String_Pointer + 1; end loop; if (Temp_String_Pointer > Temp_String'FIRST + 4) or (Temp_String_Pointer = Temp_String'FIRST) then raise YEAR_ERROR; end if; -- store the year and check its range Curr_Year := NATURAL'VALUE(Temp_String); if not (Curr_Year in CALENDAR.YEAR_NUMBER) and not (Curr_Year in Short_Year_Range) then raise YEAR_ERROR; end if; if Curr_Year in Short_Year_Range then -- special current century check: 00 = 2000 (20th century) if (Curr_Year = 00) and (Current_Century = 1900) then Curr_Year := 2000; else Curr_Year := Current_Century + Curr_Year; end if; -- special check on the year 1900 if Curr_Year = CALENDAR.YEAR_NUMBER'FIRST - 1 then raise YEAR_ERROR; end if; end if; Year := Curr_Year; end if; end Analyze_and_Process_Numeric_Date; procedure Analyze_and_Process_Combination_Date( TOD_Value : in STRING; TOD_Value_Length : in TOD_Value_Length_Type) is Local_Token : STRING(TOD_Value'FIRST .. TOD_Value'LAST); Local_TOD_Value : STRING(TOD_Value'FIRST .. TOD_Value'LAST) := TOD_Value; Local_Token_Length : TOD_Value_Length_Type; TOD_Value_Pointer : TOD_Value_Pointer_Type := Local_TOD_Value'FIRST; No_Token_Found : BOOLEAN; begin -- eliminate the slash sign(s). Replace them with blanks. for I in Local_TOD_Value'FIRST .. Local_TOD_Value'FIRST + TOD_Value_Length - 1 loop if Local_TOD_Value(I) = Slash then Local_TOD_Value(I) := Blank; end if; end loop; -- now process each "token" in turn. Note the recursion. loop Grab_a_Token(Local_TOD_Value,TOD_Value_Pointer,Local_Token,Local_Token_Length,No_Token_Found); exit when No_Token_Found; Analyze_and_Process_Token(Local_Token,Local_Token_Length,TRUE); end loop; end Analyze_and_Process_Combination_Date; -- the body of Analyze_and_Process_Date follows below begin -- check to see if we are dealing with only numerics or not if Token_Contains_No_Letters(Token,Token_Length) then Analyze_and_Process_Numeric_Date(Token,Token_Length); else Analyze_and_Process_Combination_Date(Token,Token_Length); end if; end Analyze_and_Process_Date; procedure Analyze_and_Process_Time( Token : in STRING; Token_Length : in TOD_Value_Length_Type; Hour_Only : in BOOLEAN) is Min_HourAMPM_Length : constant POSITIVE := 3; Max_HourAMPM_Length : constant POSITIVE := 4; Min_Time_Length : constant POSITIVE := 3; Max_Time_Length : constant POSITIVE := 10; subtype Hour_AMPM_Range is POSITIVE range 01 .. Noon_Hour; Curr_Hour : NATURAL; Curr_Minute, Curr_Second : NATURAL := 00; Seconds_as_Natural : NATURAL range 0 .. Number_of_Seconds_in_Day; Temp_String : STRING(Token'FIRST .. Token'LAST) := (others => Blank); Temp_String_Pointer, Token_Pointer : TOD_Value_Pointer_Type := Token'FIRST; Special_Hour_Check : BOOLEAN; begin if Tokens_Specified_Array(Time_String) then raise DUPLICATION_ERROR; end if; Tokens_Specified_Array(Time_String) := TRUE; -- check to see if only the hour was specified if Hour_Only then -- check length. Should be either 3 or 4 characters. if (Token_Length < Min_HourAMPM_Length) or (Token_Length > MAx_HourAMPM_Length) then raise TIME_STRING_ERROR; end if; -- grab the hour. Store in temporary string. while Token(Token_Pointer) in Set_of_Numerics loop Temp_String(Temp_String_Pointer) := Token(Token_Pointer); Token_Pointer := Token_Pointer + 1; Temp_String_Pointer := Temp_String_Pointer + 1; end loop; -- decode the hour and check the range Curr_Hour := NATURAL'VALUE(Temp_String); if not (Curr_Hour in Hour_AMPM_Range) then raise HOUR_ERROR; end if; -- set hours to AM/PM indicator if Curr_Hour = Noon_Hour then if Token(Token_Pointer .. Token_Pointer + 1) = "AM" then Curr_Hour := 00; else Curr_Hour := Noon_Hour; end if; elsif Token(Token_Pointer .. Token_Pointer + 1) = "PM" then Curr_Hour := Curr_Hour + Noon_Hour; end if; else -- check length. Should be between 3 and 10. if (Token_Length < Min_Time_Length) or (Token_Length > Max_Time_Length) then raise TIME_STRING_ERROR; end if; -- grab the hours. Should only find 1 or 2 characters, both -- numerics. while (Token_Pointer <= Token'FIRST + Token_Length - 1) and then (Token(Token_Pointer) /= Colon) loop Temp_String(Temp_String_Pointer) := Token(Token_Pointer); Temp_String_Pointer := Temp_String_Pointer + 1; Token_Pointer := Token_Pointer + 1; end loop; if (Temp_String_Pointer > Temp_String'FIRST + 2) or (Temp_String_Pointer = Temp_String'FIRST) then raise HOUR_ERROR; end if; -- store the number of hours and check its range Curr_Hour := NATURAL'VALUE(Temp_String); if not (Curr_Hour in 00 .. Number_of_Hours_in_Day) then raise HOUR_ERROR; end if; if Curr_Hour /= Number_of_Hours_in_Day then Special_Hour_Check := FALSE; else Special_Hour_Check := TRUE; Curr_Hour := 00; end if; -- grab the minutes. Procedure is the same as above. Token_Pointer := Token_Pointer + 1; -- bump past colon Temp_String := (others => Blank); Temp_String_Pointer := Temp_String'FIRST; while (Token_Pointer <= Token'FIRST + Token_Length - 1) and then ((Token(Token_Pointer) /= Colon) and (Token(Token_Pointer) /= 'A') and (Token(Token_Pointer) /= 'P') ) loop Temp_String(Temp_String_Pointer) := Token(Token_Pointer); Temp_String_Pointer := Temp_String_Pointer + 1; Token_Pointer := Token_Pointer + 1; end loop; if Temp_String_Pointer /= Temp_String'FIRST + 2 then raise MINUTE_ERROR; end if; -- store the number of minutes and check its range Curr_Minute := NATURAL'VALUE(Temp_String); if not (Curr_Minute in 00 .. Number_of_Minutes_in_Hour - 1) then raise MINUTE_ERROR; end if; -- grab the seconds. Procedure is the same as above. -- seconds are optional, so check for this first. if (Token_Pointer <= Token'FIRST + Token_Length - 1) and then (Token(Token_Pointer) = Colon) then Token_Pointer := Token_Pointer + 1; -- bump past colon Temp_String := (others => Blank); Temp_String_Pointer := Temp_String'FIRST; while (Token_Pointer <= Token'FIRST + Token_Length - 1) and then ((Token(Token_Pointer) /= 'A') and (Token(Token_Pointer) /= 'P') ) loop if Token(Token_Pointer) = Colon then raise TIME_STRING_ERROR; end if; Temp_String(Temp_String_Pointer) := Token(Token_Pointer); Temp_String_Pointer := Temp_String_Pointer + 1; Token_Pointer := Token_Pointer + 1; end loop; if Temp_String_Pointer /= Temp_String'FIRST + 2 then raise SECOND_ERROR; end if; -- store the number of seconds and check its range Curr_Second := NATURAL'VALUE(Temp_String); if not (Curr_Second in 00 .. Number_of_Seconds_in_Minute - 1) then raise SECOND_ERROR; end if; end if; -- check for optional AM/PM and check against hours specified if (Token_Pointer /= Token'FIRST + Token_Length - 2) and (Token_Pointer /= Token'FIRST + Token_Length) then raise TIME_STRING_ERROR; end if; if Token_Pointer = Token'FIRST + Token_Length - 2 then if not (Curr_Hour in Hour_AMPM_Range) then raise HOUR_ERROR; end if; if Curr_Hour = Noon_Hour then if Token(Token'FIRST + Token_Length - 2 .. Token'FIRST + Token_Length - 1) = "AM" then Curr_Hour := 00; else Curr_Hour := Noon_Hour; end if; elsif Token(Token'FIRST + Token_Length - 2 .. Token'FIRST + Token_Length - 1) = "PM" then Curr_Hour := Curr_Hour + Noon_Hour; end if; end if; end if; -- check for illegal time formats with hours equal to 24. if Special_Hour_Check and ((Curr_Minute /= 00) or (Curr_Second /= 00)) then raise TIME_STRING_ERROR; end if; -- compute the number of seconds given the components. Seconds_as_Natural := (Curr_Hour * Number_of_Seconds_in_Minute * Number_of_Minutes_in_Hour) + (Curr_Minute * Number_of_Seconds_in_Minute) + Curr_Second; Seconds := CALENDAR.DAY_DURATION(Seconds_as_Natural); end Analyze_and_Process_Time; -- body of Analyze_and_Process_Token follows below begin -- determine what type of token we have. See if the token contains -- only numerics, letters, etc. Call the appropriate action -- routine once we have figured out what the token can be. Also, -- if the token is not of any type that we can recognize, then -- raise EXTERNAL_REPRESENTATION_ERROR . if Token_Contains_Illegal_Characters(Token,Token_Length) then raise EXTERNAL_REPRESENTATION_ERROR; elsif Token_Contains_Only_Letters(Token,Token_Length) then Analyze_and_Process_Day_Name_or_Month_Name_or_Special(Token,Token_Length,Month_Only); elsif Token_Contains_Only_Numerics(Token,Token_Length) then Analyze_and_Process_Day_Number_or_Year_Number(Token,Token_Length); elsif Token_Contains_Slash(Token,Token_Length) then Analyze_and_Process_Date(Token,Token_Length); elsif Token_Contains_Colon_and_Numerics_with_Optional_AMPM(Token,Token_Length) then Analyze_and_Process_Time(Token,Token_Length,FALSE); elsif Token_Contains_Numerics_and_AMPM(Token,Token_Length) then Analyze_and_Process_Time(Token,Token_Length,TRUE); else raise EXTERNAL_REPRESENTATION_ERROR; end if; end Analyze_and_Process_Token; procedure Compute_Current_or_Next_Future_Date_For_a_Day_Name is TOD_String : EXTERNAL_TOD_REPRESENTATION_TYPE := CONVERT_INTERNAL_TOD_TO_EXTERNAL_TOD(Current_Time); Offset : NATURAL range 0 .. Number_of_Days_in_a_Week - 1; Target_Day_Position, Current_Day_Position : POSITIVE range 1 .. Number_of_Days_in_a_Week; begin -- store the current day position if TOD_String(Day_Name_Start .. Day_Name_End) = "SUNDAY " then Current_Day_Position := 1; elsif TOD_String(Day_Name_Start .. Day_Name_End) = "MONDAY " then Current_Day_Position := 2; elsif TOD_String(Day_Name_Start .. Day_Name_End) = "TUESDAY " then Current_Day_Position := 3; elsif TOD_String(Day_Name_Start .. Day_Name_End) = "WEDNESDAY" then Current_Day_Position := 4; elsif TOD_String(Day_Name_Start .. Day_Name_End) = "THURSDAY " then Current_Day_Position := 5; elsif TOD_String(Day_Name_Start .. Day_Name_End) = "FRIDAY " then Current_Day_Position := 6; else -- SATURDAY Current_Day_Position := 7; end if; -- store the target day position if Day_Name = "SUNDAY " then Target_Day_Position := 1; elsif Day_Name = "MONDAY " then Target_Day_Position := 2; elsif Day_Name = "TUESDAY " then Target_Day_Position := 3; elsif Day_Name = "WEDNESDAY" then Target_Day_Position := 4; elsif Day_Name = "THURSDAY " then Target_Day_Position := 5; elsif Day_Name = "FRIDAY " then Target_Day_Position := 6; else -- SATURDAY Target_Day_Position := 7; end if; -- compute the offset if Current_Day_Position = Target_Day_Position then Offset := 0; elsif Current_Day_Position < Target_Day_Position then Offset := Target_Day_Position - Current_Day_Position; else Offset := (Number_of_Days_in_a_Week - Current_Day_Position) + Target_Day_Position; end if; -- recompute Return_Time_Value if a future date was specified for I in 1 .. Offset loop if Seconds /= CALENDAR.DAY_DURATION'FIRST then Return_Time_Value := CALENDAR.TIME_OF(Year,Month,Day,Seconds) + CALENDAR.DAY_DURATION'LAST; else Return_Time_Value := CALENDAR.TIME_OF(Year,Month,Day,CALENDAR.DAY_DURATION'FIRST) + (CALENDAR.DAY_DURATION'LAST + 1.0); end if; Year := CALENDAR.YEAR(Return_Time_Value); Month := CALENDAR.MONTH(Return_Time_Value); Day := CALENDAR.DAY(Return_Time_Value); if Seconds = CALENDAR.DAY_DURATION'FIRST then Return_Time_Value := CALENDAR.TIME_OF(Year,Month,Day,CALENDAR.DAY_DURATION'FIRST); end if; end loop; end Compute_Current_or_Next_Future_Date_For_a_Day_Name; procedure Perform_Error_Checking_and_Wrap_Up_Loose_Ends is begin -- if a day name and date were specified, make sure that the -- day name is correct for that date. if Tokens_Specified_Array(Day_as_Name) and Tokens_Specified_Array(Day_as_Number) and Compute_Day_of_Week(CALENDAR.TIME_OF(Year,Month,Day,Seconds)) /= Day_Name then raise DAY_DATE_ERROR; end if; -- make sure that if a special format token was specified, that -- the date was not also specified. if (Tokens_Specified_Array(Special_Format)) and (Tokens_Specified_Array(Day_as_Name) or Tokens_Specified_Array(Day_as_Number) or Tokens_Specified_Array(Month_Name_or_Number) or Tokens_Specified_Array(Year_Number) ) then raise EXTERNAL_REPRESENTATION_ERROR; end if; -- make sure that if any part of a date token was specified, that -- at least the day number and month were specified. if Tokens_Specified_Array(Day_as_Number) and (not Tokens_Specified_Array(Month_Name_or_Number)) then raise MONTH_MISSING_ERROR; elsif Tokens_Specified_Array(Month_Name_or_Number) and (not Tokens_Specified_Array(Day_as_Number)) then raise DAY_NUMBER_MISSING_ERROR; elsif Tokens_Specified_Array(Year_Number) and ((not Tokens_Specified_Array(Month_Name_or_Number)) or (not Tokens_Specified_Array(Day_as_Number)) ) then raise EXTERNAL_REPRESENTATION_ERROR; end if; -- now set the internal time if a date or time token was found. if Tokens_Specified_Array(Day_as_Number) or Tokens_Specified_Array(Time_String) then Return_Time_Value := CALENDAR.TIME_OF(Year,Month,Day,Seconds); end if; -- if the day name was specified without a date, then compute the -- current or next future internal time format as of that day. if Tokens_Specified_Array(Day_as_Name) and (not Tokens_Specified_Array(Day_as_Number)) then Compute_Current_or_Next_Future_Date_For_a_Day_Name; end if; end Perform_Error_Checking_and_Wrap_Up_Loose_Ends; -- the body of CONVERT_EXTERNAL_TOD_TO_INTERNAL_TOD follows below begin -- check for a null array... let's not deal with it if TOD_Value'FIRST > TOD_Value'LAST then raise EXTERNAL_REPRESENTATION_ERROR; end if; -- compress the external representation, that is, eliminate all -- unnecessary blanks and/or commas. Then convert all lower case -- letters to upper case. Compress_External_Representation(TOD_Value,TOD_Value_Compressed_Length); Convert_External_Representation_to_Upper_Case(TOD_Value); if TOD_Value_Compressed_Length < Minimum_TOD_STRING_Length then raise EXTERNAL_REPRESENTATION_ERROR; end if; -- now loop on all tokens in the external representation. Analyze -- and process each token. Some error checking may be needed -- after all tokens are found. loop Grab_a_Token(TOD_Value,TOD_Value_Pointer,Token,Token_Length,No_Token_Found); exit when No_Token_Found; Analyze_and_Process_Token(Token,Token_Length,FALSE); end loop; -- now perform special error checking and wrap up loose ends Perform_Error_Checking_and_Wrap_Up_Loose_Ends; -- now return the CALENDAR.TIME internal representation. If -- during the processing, CALENDAR.TIME_ERROR was raised, then -- we trap it and send back DATE_ERROR . If any other exception -- was raised, we do nothing and instead let the caller handle it. return Return_Time_Value; exception when CALENDAR.TIME_ERROR => raise DATE_ERROR; end CONVERT_EXTERNAL_TOD_TO_INTERNAL_TOD; end TOD_UTILITIES; -------