|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 13459 (0x3493)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
with Text_Io;
with Calendar;
with Job_Segment;
with Sort_Generic;
with Time_Utilities;
with String_Utilities;
with Ersatz_Array_Generic;
procedure Print_Events (On : in String := "";
Calendar_File : in String := "") is
package Tio renames Text_Io;
package Iio is new Tio.Integer_Io (Num => Integer);
package Tu renames Time_Utilities;
type Mode_Enumeration is (Year, Month, Week, Day);
type Days is (Monday, Tuesday, Wednesday,
Thursday, Friday, Saturday, Sunday);
type Action_Type is (Error, Match_Day, Match_Date);
type String_Ptr is access String;
type Date_Record is
record
Month : Calendar.Month_Number;
Day : Calendar.Day_Number;
Year : Calendar.Year_Number;
Date : Calendar.Time;
Time : Natural;
Day_In_Week : Natural;
Line : String_Ptr;
Sort_Tie_Breaker : Natural;
end record;
type Date_Record_Ptr is access Date_Record;
pragma Segmented_Heap (Date_Record_Ptr);
package Line_Array_Package is
new Ersatz_Array_Generic (Date_Record, Date_Record_Ptr,
Positive, Job_Segment.Get);
function Line_Array (E : Positive) return Date_Record_Ptr
renames Line_Array_Package.Fetch;
function Less_Than (L, R : Positive) return Boolean;
procedure Sort is new Sort_Generic
(Positive, Less_Than, Line_Array_Package.Exchange);
Action : Action_Type;
Today : Date_Record;
Target : Date_Record;
Seconds : Calendar.Day_Duration;
Tomorrow : Date_Record;
Current_Line : Natural := 0;
Last_Month : Natural;
Last_Day : Calendar.Time;
Mode : Mode_Enumeration := Week;
One_Day : constant Duration := 86401.0;
Cal_Fd : Tio.File_Type;
Input_Line : String (1 .. 200);
Char_Count : Natural;
First_Unused : Natural;
Feb : constant Integer := 2;
Apr : constant Integer := 4;
Jun : constant Integer := 6;
Sep : constant Integer := 9;
Nov : constant Integer := 11;
procedure Get_Date (Today : Date_Record;
Result_Action : out Action_Type;
Target : in out Date_Record;
Input_Line : String;
Char_Pos : in out Natural) is
I : Integer;
Last_Char : Natural := Input_Line'Last;
Last_Used_Char : Natural;
begin
Result_Action := Error;
Iio.Get (Input_Line (Char_Pos .. Last_Char), I, Last_Used_Char);
Char_Pos := Last_Used_Char + 1;
if Char_Pos > Last_Char or else Input_Line (Char_Pos) /= '/' then
Target.Day_In_Week := I;
Result_Action := Match_Day;
return;
end if;
if I not in Calendar.Month_Number then
Text_Io.Put_Line ("** " & Input_Line & " has a bad month");
return;
end if;
Target.Month := I;
Char_Pos := Char_Pos + 1;
Iio.Get (Input_Line (Char_Pos .. Last_Char), I, Last_Used_Char);
Char_Pos := Last_Used_Char + 1;
if I not in Calendar.Day_Number then
Text_Io.Put_Line ("** " & Input_Line & " has a bad day");
return;
end if;
Target.Day := I;
if Char_Pos > Last_Char or else Input_Line (Char_Pos) /= '/' then
I := Today.Year;
else
Char_Pos := Char_Pos + 1;
Iio.Get (Input_Line (Char_Pos .. Last_Char), I, Last_Used_Char);
Char_Pos := Last_Used_Char + 1;
if I < 100 then
I := I + 1900;
elsif I not in Calendar.Year_Number then
Text_Io.Put_Line ("** " & Input_Line & " has a bad year");
return;
end if;
end if;
Target.Year := I;
Target.Date := Calendar.Time_Of (Target.Year, Target.Month, Target.Day);
Result_Action := Match_Date;
exception
when Calendar.Time_Error =>
Text_Io.Put_Line ("** " & Input_Line & " is ill formed");
Result_Action := Error;
end Get_Date;
procedure Compute_Day_In_Week (Day : in out Date_Record) is
Number_Of_Days : Natural;
begin
Number_Of_Days := (Day.Year - 1900) * 365 + (Day.Day - 1);
for I in 1 .. Day.Month - 1 loop
case I is
when Apr | Jun | Sep | Nov =>
Number_Of_Days := Number_Of_Days + 30;
when Feb =>
Number_Of_Days := Number_Of_Days + 28;
when others =>
Number_Of_Days := Number_Of_Days + 31;
end case;
end loop;
Number_Of_Days := Number_Of_Days + (Number_Of_Days + 1401) / 1460;
Day.Day_In_Week := Number_Of_Days rem 7;
if Day.Day_In_Week = 0 then
Day.Day_In_Week := 7;
end if;
end Compute_Day_In_Week;
function Less_Than (L, R : Positive) return Boolean is
Left : Date_Record_Ptr := Line_Array (L);
Right : Date_Record_Ptr := Line_Array (R);
begin
if Calendar."<" (Left.Date, Right.Date) then
return True;
end if;
if Calendar."=" (Left.Date, Right.Date) then
if Left.Time < Right.Time then
return True;
end if;
if Left.Time = Right.Time then
return Left.Sort_Tie_Breaker < Right.Sort_Tie_Breaker;
end if;
end if;
return False;
end Less_Than;
procedure Compute_Time (Date : in out Date_Record) is
Str : constant String := Date.Line.all;
Pos : Natural := Str'First;
Last : Natural := Str'Last;
Colon : Natural;
Hours : Natural;
Minutes : Natural;
Worked : Boolean;
begin
Date.Time := 0;
if Str'Length < 4 or else (Str (Pos) < '0' or Str (Pos) > '9') then
return;
end if;
Colon := String_Utilities.Locate (':', Str);
if Colon = 0 or Colon - Pos > 2 then
return;
end if;
String_Utilities.String_To_Number
(Str (Pos .. Colon - 1), Hours, Worked);
if not Worked or else Hours > 23 then
return;
end if;
Colon := Colon + 1;
Pos := Colon;
while Pos <= Last and then Str (Pos) in '0' .. '9' loop
Pos := Pos + 1;
end loop;
if Pos > Last or Pos = Colon then
return;
end if;
String_Utilities.String_To_Number
(Str (Colon .. Pos - 1), Minutes, Worked);
if not Worked or else Minutes > 59 then
return;
end if;
case Str (Pos) is
when 'a' | 'A' =>
null;
when 'p' | 'P' =>
if Hours = 12 then
Hours := 0;
elsif Hours < 12 then
Hours := Hours + 12;
end if;
when others =>
if Hours <= 7 then
Hours := Hours + 12;
end if;
end case;
Date.Time := Hours * 60 + Minutes;
end Compute_Time;
procedure Add_Line (Date : Date_Record; Text : String) is
Temp : Date_Record := Date;
begin
Current_Line := Current_Line + 1;
Temp.Line := new String'(String_Utilities.Strip_Leading (Text));
Temp.Sort_Tie_Breaker := Current_Line;
Compute_Time (Temp);
Line_Array (Current_Line).all := Temp;
end Add_Line;
begin
Tio.Open (Cal_Fd, Tio.In_File, Calendar_File);
Calendar.Split (Calendar.Clock, Today.Year,
Today.Month, Today.Day, Seconds);
Compute_Day_In_Week (Today);
Mode := Day;
First_Unused := On'First;
if On'Length /= 0 then
case On (First_Unused) is
when 'w' | 'W' =>
Mode := Week;
First_Unused := First_Unused + 1;
when 'y' | 'Y' =>
Mode := Year;
First_Unused := First_Unused + 1;
when 'm' | 'M' =>
Mode := Month;
First_Unused := First_Unused + 1;
when 'd' | 'D' =>
Mode := Day;
First_Unused := First_Unused + 1;
when others =>
null;
end case;
end if;
if On'Last >= First_Unused then
Get_Date (Today, Action, Target,
On (First_Unused .. On'Last), First_Unused);
case Action is
when Match_Date =>
Today.Year := Target.Year;
Today.Month := Target.Month;
Today.Day := Target.Day;
when Match_Day =>
if Target.Day_In_Week > 1900 then
Today.Year := Target.Day_In_Week;
Today.Month := 1;
Mode := Year;
else
Today.Month := Target.Day_In_Week;
Mode := Month;
end if;
Today.Day := 1;
when Error =>
Text_Io.Put_Line (On & ":bad argument date/day");
return;
end case;
end if;
Today.Date := Calendar.Time_Of (Today.Year, Today.Month, Today.Day);
Compute_Day_In_Week (Today);
case Mode is
when Week =>
while Today.Day_In_Week mod 7 > 1 loop
Today.Date := Calendar."-" (Today.Date, One_Day);
Calendar.Split (Today.Date, Today.Year,
Today.Month, Today.Day, Seconds);
Compute_Day_In_Week (Today);
end loop;
Today.Date := Calendar.Time_Of (Today.Year, Today.Month, Today.Day);
Tomorrow := Today;
for I in 1 .. 7 loop
Tomorrow.Date := Calendar."+" (Tomorrow.Date, One_Day);
Calendar.Split (Tomorrow.Date, Tomorrow.Year,
Tomorrow.Month, Tomorrow.Day, Seconds);
end loop;
when Month =>
Today.Day := 1;
Today.Date := Calendar.Time_Of (Today.Year, Today.Month, Today.Day);
Compute_Day_In_Week (Today);
Tomorrow := Today;
case Today.Month is
when Feb =>
Tomorrow.Day := 28;
when Apr | Jun | Sep | Nov =>
Tomorrow.Day := 30;
when others =>
Tomorrow.Day := 31;
end case;
when Year =>
Today.Month := 1;
Today.Day := 1;
Today.Date := Calendar.Time_Of (Today.Year, Today.Month, Today.Day);
Compute_Day_In_Week (Today);
Tomorrow := Today;
Tomorrow.Month := 12;
Tomorrow.Day := 31;
when Day =>
Tomorrow := Today;
end case;
Tomorrow.Date := Calendar.Time_Of
(Tomorrow.Year, Tomorrow.Month, Tomorrow.Day);
Compute_Day_In_Week (Tomorrow);
while not Tio.End_Of_File (Cal_Fd) loop
Tio.Get_Line (Cal_Fd, Input_Line, Char_Count);
First_Unused := 1;
Get_Date (Today, Action, Target,
Input_Line (1 .. Char_Count), First_Unused);
Compute_Day_In_Week (Target);
case Action is
when Match_Date =>
if Calendar.">=" (Target.Date, Today.Date) and
Calendar."<=" (Target.Date, Tomorrow.Date) then
Add_Line (Target, Input_Line (First_Unused .. Char_Count));
end if;
when Match_Day =>
if Target.Day_In_Week < Today.Day_In_Week then
Target.Day_In_Week := Target.Day_In_Week + 7;
end if;
if Target.Day_In_Week >= Today.Day_In_Week and
Target.Day_In_Week <= Tomorrow.Day_In_Week then
Add_Line (Target, Input_Line (First_Unused .. Char_Count));
end if;
when Error =>
null;
end case;
end loop;
Tio.Close (Cal_Fd);
if Current_Line = 0 then
return;
end if;
Sort (1, Current_Line);
Last_Day := Tu.Convert_Time (Tu.Nil);
Last_Month := 0;
for I in 1 .. Current_Line loop
declare
E : Date_Record_Ptr := Line_Array (I);
begin
if (Mode = Month or Mode = Year) and Last_Month /= E.Month then
Text_Io.New_Line (2);
Text_Io.Put_Line
(" *** " &
Tu.Months'Image (Tu.Months'Val (E.Month - 1)) & " ***");
Last_Month := E.Month;
end if;
if E.Day_In_Week > 7 then
E.Day_In_Week := E.Day_In_Week - 7;
end if;
if Calendar."/=" (E.Date, Last_Day) then
Last_Day := E.Date;
Tio.New_Line;
Text_Io.Put_Line (Days'Image (Days'Val (E.Day_In_Week - 1)) &
" " & Tu.Image (Tu.Convert_Time (E.Date),
Contents => Tu.Date_Only));
Tio.New_Line;
end if;
Text_Io.Put_Line (" " & E.Line.all);
end;
end loop;
exception
when Tio.Name_Error =>
Text_Io.Put_Line (Calendar_File & ":cannot find calendar file");
end Print_Events;