(FILECREATED " 1-Oct-87 11:30:21" {QV}<BRIGGS>LISP>TRICKLE.;17 9020
changes to: (FNS TrickleProcessLogfile)
previous date: "12-Jun-87 20:29:07" {QV}<BRIGGS>LISP>TRICKLE.;16)
(* 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 (QUOTE {qv}<briggs>lispusers-))
(SUBSTRING DateString 7 8)
(SUBSTRING DateString 4 5)
(SUBSTRING DateString 1 2)
(QUOTE .COPYLOG] (* ;;
"fix up the file name for the case where the day is less than 10")
[if (EQ (QUOTE % )
(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 (QUOTE >A)
(LIST (QUOTE OUTPUT)
LogfileName))
(if (NULL DontReplaceOldVersions)
then (LIST (QUOTE REPLACE]
(TrickleProcessLogfile LogfileName MailAddress Source Destination)
(if (EQ ScheduleAnotherOne T)
then (SETREMINDER (MKATOM (CONCAT "Trickle-" (GENSYM)
"-" Source))
NIL
(BQUOTE (Trickle (QUOTE (\, Source))
(QUOTE (\, 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
(BQUOTE (Trickle (QUOTE (\, Source))
(QUOTE (\, 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 (QUOTE LEFT))
(SETQ EndsOfLines (CONS 0 (while (SETQ EndOfLine (TEDIT.FIND LogfileStream
EOLCharacter))
collect (TEDIT.SETSEL LogfileStream EndOfLine 1
(QUOTE 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)
(QUOTE (CREATIONDATE))
(QUOTE (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
(QUOTE
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 (QUOTE
CREATIONDATE]
elseif (SETQ FILESPEC (INFILEP FILESPEC))
then (APPLY* FN FILESPEC (GETFILEINFO FILESPEC (QUOTE CREATIONDATE])
)
(PUTPROPS TRICKLE COPYRIGHT ("Xerox Corporation" 1985 1986 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (672 6537 (Trickle 682 . 3197) (TrickleProcessLogfile 3199 . 6535)) (6686 8932 (MAPFILES
6696 . 8930)))))
STOP