(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED " 4-Oct-87 17:57:05" {ERINYES}<LISPUSERS>LYRIC>TRICKLE.;1 10480
previous date%: " 1-Oct-87 11:30:21" {ERINYES}<LISPUSERS>KOTO>TRICKLE.;4)
(* "
Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT TRICKLECOMS)
(RPAQQ TRICKLECOMS ((FILES (SYSLOAD)
PROMPTREMINDERS COPYFILES)
(FNS Trickle TrickleProcessLogfile)
(COMS (* * patch MAPFILES so that it doesn't generate <directory>.;1 files which
cause copy of top level IFS directory to NS file server to choke)
(FNS MAPFILES))))
(FILESLOAD (SYSLOAD)
PROMPTREMINDERS COPYFILES)
(DEFINEQ
(Trickle
[LAMBDA (Source Destination RootLogfileName MailAddress ScheduleAnotherOne DontReplaceOldVersions)
(* N.H.Briggs "12-Jun-87 20:28")
(LET* [(DateString (DATE (DATEFORMAT SPACES NUMBER.OF.MONTH NO.TIME)))
(LogfileName (PACK* (OR RootLogfileName '{qv}<briggs>lispusers-)
(SUBSTRING DateString 7 8)
(SUBSTRING DateString 4 5)
(SUBSTRING DateString 1 2)
'.COPYLOG]
(* ;; "fix up the file name for the case where the day is less than 10")
[if (EQ '% (NTHCHAR LogfileName -10))
then (SETQ LogfileName (MKATOM (RPLSTRING LogfileName -10 "0"]
(* ;; "ensure that the logfile has one line per file operated on")
[RESETVAR FILELINELENGTH 1000 (COPYFILES Source Destination
(APPEND (LIST '>A (LIST 'OUTPUT LogfileName))
(if (NULL DontReplaceOldVersions)
then (LIST 'REPLACE]
(TrickleProcessLogfile LogfileName MailAddress Source Destination)
(if (EQ ScheduleAnotherOne T)
then (SETREMINDER (MKATOM (CONCAT "Trickle-" (GENSYM)
"-" Source))
NIL
`(Trickle ',Source ',Destination ,RootLogfileName ,MailAddress ,
ScheduleAnotherOne ,DontReplaceOldVersions)
(CONCAT (SUBSTRING [GDATE (PLUS (IDATE)
(CONSTANT (TIMES 60 60 24]
1 10)
(RAND 1 5)
":"
(RAND 0 59)))
elseif (AND ScheduleAnotherOne (IDATE (CONCAT "1-jan-87 " ScheduleAnotherOne)))
then (SETREMINDER (MKATOM (CONCAT "Trickle-" (GENSYM)
"-" Source))
NIL
`(Trickle ',Source ',Destination ,RootLogfileName ,MailAddress ,
ScheduleAnotherOne ,DontReplaceOldVersions)
(CONCAT (SUBSTRING [GDATE (PLUS (IDATE)
(CONSTANT (TIMES 60 60 24]
1 10)
ScheduleAnotherOne])
(TrickleProcessLogfile
[LAMBDA (LogfileName MailAddress Source Destination) (* N.H.Briggs " 1-Oct-87 11:29")
(PROG (LogfileStream EndsOfLines (EOLCharacter (CHARACTER (CHARCODE EOL)))
EndOfLine Deletions)
(SETQ LogfileStream (OPENTEXTSTREAM LogfileName))
(if (ZEROP (GETEOFPTR LogfileStream))
then
(* * probably errored -
people don't usually Trickle empty directories)
(if MailAddress
then (TEDIT.INSERT LogfileStream
(PACK* "Subject: (Error?) Trickle:" Source " to " Destination
EOLCharacter "To: " MailAddress EOLCharacter EOLCharacter)
1)
(LAFITE.SENDMESSAGE LogfileStream)
(CLOSEF LogfileStream)
(RETURN)))
(TEDIT.SETSEL LogfileStream 1 1 'LEFT)
(SETQ EndsOfLines (CONS 0 (while (SETQ EndOfLine (TEDIT.FIND LogfileStream EOLCharacter))
collect (TEDIT.SETSEL LogfileStream EndOfLine 1 'RIGHT)
EndOfLine)))
(* * find lines with "skipped" and collect for deletion)
(* * TEDIT.FIND is very poor on long files, see AR# 4220)
[for EndOfPreviousLine on EndsOfLines bind StartOfLine EndOfLine
eachtime [SETQ StartOfLine (AND EndOfPreviousLine (ADD1 (CAR EndOfPreviousLine]
(SETQ EndOfLine (CADR EndOfPreviousLine))
when [AND EndOfLine (STRPOS "skipped" (TEDIT.SEL.AS.STRING LogfileStream
(TEDIT.SETSEL LogfileStream StartOfLine
(ADD1 (IDIFFERENCE EndOfLine
StartOfLine]
do
(* * if this deletion is an extension of the previous one, then extend the
previous one, otherwise add this to the collection.
This collapsing makes the actual deletion much more efficient, since we expect
to have few of the lines kept.)
(if (AND Deletions (EQUAL (PLUS (CAAR Deletions)
(CDAR Deletions))
StartOfLine))
then [RPLACD (CAR Deletions)
(PLUS (CDAR Deletions)
(DIFFERENCE EndOfLine (CAR EndOfPreviousLine]
else (push Deletions (CONS StartOfLine (DIFFERENCE EndOfLine (CAR EndOfPreviousLine
]
(* * do collected deletions)
(for Deletion in Deletions do (TEDIT.DELETE LogfileStream (CAR Deletion)
(CDR Deletion)))
(* * KLUDGE! TEDIT.PUT bombs after putting the file if the stream doesn't have
a window associated)
(NLSETQ (TEDIT.PUT LogfileStream LogfileName T T))
(* * construct a mail message and send it)
(if MailAddress
then (TEDIT.INSERT LogfileStream (PACK* (if (NOT (ZEROP (GETEOFPTR LogfileStream)))
then "Subject: Trickle: "
else "Subject: (Empty) Trickle:")
Source " to " Destination EOLCharacter "To: "
MailAddress EOLCharacter EOLCharacter)
1)
(LAFITE.SENDMESSAGE LogfileStream))
(CLOSEF LogfileStream])
)
(* * patch MAPFILES so that it doesn't generate <directory>.;1 files which cause copy of top level IFS
directory to NS file server to choke)
(DEFINEQ
(MAPFILES
[LAMBDA (FILESPEC FN DEFAULTEXT DEFAULTVERS) (* edited%: "29-May-87 13:42")
(* jds "27-Feb-85 11:46")
(* Run thru all the files that match FILESPEC, calling FN on each such file
name)
(if (LISTP FILESPEC)
then (for X in FILESPEC do (MAPFILES X FN DEFAULTEXT DEFAULTVERS))
elseif [OR (STRPOS "*" FILESPEC)
(FMEMB (NTHCHARCODE FILESPEC -1)
(CHARCODE (> %) %] } %:]
then
[PROG ([FILEGROUP (\GENERATEFILES (DIRECTORY.FILL.PATTERN FILESPEC DEFAULTEXT DEFAULTVERS)
'(CREATIONDATE)
'(SORT]
NAME)
(if COPYFILESENUMERATE
then (for PAIR
in [while (eachtime (SETQ NAME (\GENERATENEXTFILE FILEGROUP))
while (STREQUAL (SUBSTRING NAME
(OR (STRPOS ">" NAME NIL NIL NIL T NIL
T)
0))
".;1") finally (RETURN NAME))
collect (CONS (if (LISTP NAME)
then (CONCATCODES NAME)
else NAME)
(\GENERATEFILEINFO FILEGROUP 'CREATIONDATE]
do (APPLY* FN (CAR PAIR)
(CDR PAIR)))
else (while (eachtime (SETQ NAME (\GENERATENEXTFILE FILEGROUP))
while (STREQUAL (SUBSTRING NAME
(OR (STRPOS ">" NAME NIL NIL NIL T NIL T)
0))
".;1") finally (RETURN NAME))
do (APPLY* FN (if (LISTP NAME)
then (CONCATCODES NAME)
else NAME)
(\GENERATEFILEINFO FILEGROUP 'CREATIONDATE]
elseif (SETQ FILESPEC (INFILEP FILESPEC))
then (APPLY* FN FILESPEC (GETFILEINFO FILESPEC 'CREATIONDATE])
)
(PUTPROPS TRICKLE COPYRIGHT ("Xerox Corporation" 1985 1986 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (792 7621 (Trickle 802 . 3517) (TrickleProcessLogfile 3519 . 7619)) (7770 10391 (
MAPFILES 7780 . 10389)))))
STOP