home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Club Amiga de Montreal - CAM
/
CAM_CD_1.iso
/
files
/
391.lha
/
IsToday_v1.0
/
IsToday.mod.BM
< prev
next >
Wrap
Text File
|
1990-07-03
|
7KB
|
141 lines
(* Benchmark version *)
(* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* *
* Public domain! V1.0 by David Czaya *
* (PLink -Dave-) *
* (CIS 73445,407) *
* 27-June-1990 (GEnie DCzaya) *
* *
* Usage: IsToday [day] where [day] is Sun, Monday, Tues... *
* *
* IsToday compares [day] with the system clock's "Day of Week" *
* and sets the CLI return code as follows: *
* *
* no match - 0 (Ok) *
* match - 5 (WARN) *
* error - 20 (FAIL) *
* *
* "IsToday" is meant to be used within a script. I wrote IsToday *
* because my job requires that every Monday morning I'm supposed *
* to mail out a certain check and for some reason, I'd constantly *
* forget to do it. :-) *
* *
* Now, my Startup-Sequence says: *
* *
* IsToday Monday *
* IF WARN *
* echo "It's Monday. Go mail the check." *
* ENDIF *
* *
* Now, when I boot up Monday morning, I get the reminder. Simple. *
* Easy. Problem solved! I'm sure you can find a use for it. I *
* realize there are other CHRON-like programs that do this and *
* much, much more, but I prefer the simplicity of this. *
* *
* Thanks for trying IsToday... *
* *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)
MODULE IsToday;
FROM System IMPORT argc, argv, CLIReturnCode;
FROM AmigaDOS IMPORT DateStamp, DateStampPtr,
ReturnOk, ReturnWarn, ReturnFail;
FROM Memory IMPORT AllocMem, FreeMem, MemClear, MemPublic, MemReqSet;
FROM Strings IMPORT ExtractSubString, LocateSubString,
ConvStringToUpperCase;
FROM TermInOut IMPORT WriteString;
CONST (* some constants to keep up front *)
DOW = "SUNMONTUEWEDTHUFRISAT";
CursorOff = '\x9B0 p';
CursorOn = '\x9B p';
Usage1 =
"Usage: IsToday [day] where [day] is Sun, Mon, Tue...\n\n\
IsToday compares [day] with the system clock's \"Day of Week\" and\n\
sets the CLI return code as follows:\n\n";
Usage2 =
" match - 0 (Ok)\n\
no match - 5 (WARN)\n\
error - 20 (FAIL)\n\n\
Public domain! V1.0 by David Czaya 27-June-1990\n";
VAR
arg : ARRAY [0..3] OF CHAR; (* contains converted user argument *)
daynum : INTEGER; (* day number where: 0 - Sunday *)
(* 1 - Monday *)
(* 2 - etc. *)
PROCEDURE Usage();
BEGIN
WriteString(CursorOff);
WriteString(Usage1);
WriteString(Usage2);
WriteString(CursorOn);
CLIReturnCode := ReturnFail; (* return FAIL 20 *)
HALT;
END Usage;
PROCEDURE GetDayOfWeek(date: DateStampPtr): CARDINAL;
VAR
d,m,n,y : CARDINAL;
BEGIN
n := date^.dsDays - 2251D; (* standard Datestamp *)
y := (4 * n + 3) DIV 1461; (* conversion routine *)
DEC(n,1461 * y DIV 4);
INC(y,1984);
m := ((5 * n + 2) DIV 153);
d := n - (153 * m + 2) DIV 5 + 1;
INC(m,3);
IF m > 12 THEN
INC(y);
DEC(m,12);
END; (* standard "Get Day Of Week *)
(* conversion routine *)
RETURN (d + m * 2 + CARDINAL(TRUNC((FLOAT(m) + 1.0) * 0.6))
+ 1 + y + (y DIV 4) - (y DIV 100) + (y DIV 400) ) MOD 7;
END GetDayOfWeek;
PROCEDURE Today(isday: INTEGER): BOOLEAN;
VAR
ds : DateStampPtr;
today : INTEGER;
BEGIN
ds := AllocMem(SIZE(ds^),MemReqSet{MemPublic,MemClear});
IF ds = NIL THEN
WriteString("Memory error!\n"); (* Big problems *)
CLIReturnCode := ReturnFail; (* return FAIL 20 *)
HALT; (* and leave. *)
ELSE
DateStamp(ds^); (* get the datestamp *)
today := GetDayOfWeek(ds); (* conversion to DOW *)
FreeMem(ds,SIZE(ds^)); (* clean up mem alloc *)
END;
RETURN(isday = today); (* return with system *)
END Today; (* "Day of Week" *)
BEGIN (* main *)
IF (argc # 2) OR (argv^[1]^[0] = '?') THEN Usage() END;
ExtractSubString(arg,argv^[1]^,0,3); (* grab first 3 chars of argv *)
ConvStringToUpperCase(arg); (* make 'em all CAPS *)
daynum := LocateSubString(DOW,arg,0,21); (* see if arg is a valid day, *)
IF daynum > -1 THEN (* yep, 'tis. Convert daynum *)
IF Today(daynum DIV 3) THEN (* to [0..6] DOW format and *)
CLIReturnCode := ReturnWarn; (* get system DOW. Compare *)
ELSE (* and return WARN 5 or *)
CLIReturnCode := ReturnOk; (* Ok (0) *)
END;
ELSE (* invalid argument from user *)
CLIReturnCode := ReturnFail; (* return FAIL 20 *)
END;
END IsToday.