(FILECREATED "25-Mar-86 13:22:34" {LOGOS:AFB:SIP}<DOUG>LISP>DUMPER.;10 8672
changes to: (FNS DUMP.DUMP DUMP.DIRECTORY DUMP DUMP.LOG.FILENAME DUMP.NEW.FILENAME
DUMP.DIRECTORIES)
(VARS DUMPERCOMS)
previous date: "24-Mar-86 21:40:40" {LOGOS:AFB:SIP}<DOUG>LISP>DUMPER.;7)
(* Copyright (c) 1986, 1901 by Speech Input Project, Univ. of Edinburgh. All rights reserved.)
(PRETTYCOMPRINT DUMPERCOMS)
(RPAQQ DUMPERCOMS ((FNS DUMP DUMP.DUMP DUMP.NEW.FILENAME DUMP.DIRECTORIES DUMP.DIRECTORY
DUMP.GENERATE.NEWERTHAN DUMP.NVERSIONS)
(INITVARS (DUMP.IGNORE.DIRS '(FONTS CLEARINGHOUSE SYSTEMFILES DESKTOPS))
(DUMP.IGNORE.SPECS '(*.DCOM;* *.SYSOUT;*))
(DUMP.DIRECTORY.SEPARATOR "\"))))
(DEFINEQ
(DUMP
[LAMBDA (HOST TO.DIRECTORY LOG.FILE NEWERTHAN NVERSIONS) (* drc: "25-Mar-86 12:43")
(* * Will dump all files on NS file server HOST which are newer than NEWERTHAN, a date string, with a maximum of
NVERSIONS of a particular file being dumped to TO.DIRECTORY. If NEWERTHAN is NIL than all versions written since
(GDATE 0) will be dumped. If NVERSIONS is NIL then all versions will be dumped. A log file will be written to a
file w/ name specified by DUMP.LOG.FILENAME. Returns the log file name.)
(DECLARE (GLOBALVARS DUMP.IGNORE.SPECS))
(RESETLST (LET ((IDATE (if NEWERTHAN
then (IDATE NEWERTHAN)
else 0))
(FILTERS (MAPCAR DUMP.IGNORE.SPECS (FUNCTION DIRECTORY.MATCH.SETUP)))
LOG FILES) (* do a little arg checking)
(OR (FIXP IDATE)
(ERROR NEWERTHAN "ARG NOT A DATE STRING"))
(OR (STRPOS ":" (MKSTRING HOST))
(ERROR HOST "NOT AN NS HOST"))
(SETQ LOG (OPENSTREAM LOG.FILE 'OUTPUT
'NEW))
(RESETSAVE NIL (LIST 'CLOSEF?
LOG))
(printout LOG "Dump of server " HOST " on " (DATE)
" to " TO.DIRECTORY "." T "Dumping " (OR NVERSIONS "all")
" versions of each file written since "
(GDATE IDATE)
"." T)
(printout LOG "Not dumping files on directories :")
(for DIR in DUMP.IGNORE.DIRS do (PRINTOUT LOG " " DIR))
(printout LOG T "Not dumping files which match :")
(for SPEC in DUMP.IGNORE.SPECS do (PRINTOUT LOG " " SPEC))
(printout LOG T T) (* actually do the dump.)
(for DIR in (DUMP.DIRECTORIES HOST) bind FILES
do (PRINTOUT T DIR)
(SETQ FILES (DUMP.DIRECTORY HOST DIR IDATE NVERSIONS FILTERS LOG))
(printout T "(" (FLENGTH FILES)
")")
(DUMP.DUMP FILES TO.DIRECTORY LOG)
(PRINTOUT T "OK" T))
(printout LOG T (DATE)
" Done with backups." T)
(CLOSEF LOG])
(DUMP.DUMP
[LAMBDA (FILES TO.DIR LOG) (* drc: "25-Mar-86 13:02")
(* * Will copy all files in FILES to TO.DIR, renaming files as specified by DUMP.NEW.FILENAME.
Each file copied is recorded in LOG, a stream opened for output.)
(for FILE in FILES as N from 1 bind VALUE NEWNAME
do (SETQ N9]AME (DUMP.NEW.FILENAME FILE TO.DIR))
(SETQ VALUE (NLSETQ (COPYFILE FILE NEWNAME)))
(if (LISTP VALUE)
then (* file dumped successfully)
(PRINTOUT T (if (ZEROP (REMAINDER N 10))
then N
else "."))
(printout LOG FILE T)
else (* error occurred)
(LET ((ERROR (ERRORN)))
(PRINTOUT T (ERRORSTRING (CAR ERROR))
" "
(CADR ERROR)
T FILE " Not dumped." T)
(PRINTOUT LOG (ERRORSTRING (CAR ERROR))
" "
(CADR ERROR)
T FILE " Not dumped." T])
(DUMP.NEW.FILENAME
[LAMBDA (FILE TO.DIR) (* drc: "25-Mar-86 12:00")
(* * Replaces >'s in the DIRECTORY field of file with DUMP.DIRECTORY.SEPARATOR.)
(DECLARE (GLOBALVARS DUMP.DIRECTORY.SEPARATOR))
(LET ((FILEFIELDS (UNPACKFILENAME FILE)))
(PACKFILENAME 'NAME
(CONCAT [CONCATLIST (DSUBST DUMP.DIRECTORY.SEPARATOR '>
(UNPACK (LISTGET FILEFIELDS
'DIRECTORY]
DUMP.DIRECTORY.SEPARATOR
(LISTGET FILEFIELDS 'NAME))
'EXTENSION
(LISTGET FILEFIELDS 'EXTENSION)
'VERSION
NIL
'BODY
TO.DIRECTORY])
(DUMP.DIRECTORIES
[LAMBDA (HOST) (* drc: "25-Mar-86 12:05")
(* * Returns a list of the names of all the top-level directories on NS host HOST except those on DUMP.IGNORE.DIRS)
(DECLARE (GLOBALVARS DUMP.IGNORE.DIRS))
(LET [(DIRS (MAPCAR (DIRECTORY (PACKFILENAME 'HOST
HOST
'DIRECTORY
'*))
(FUNCTION (LAMBDA (SPEC) (* DIRECTORY of {host:}<*> returns a list of
{host:}<*>.;1)
(MKATOM (U-CASE (FILENAMEFIELD SPEC 'DIRECTORY]
(for DIR in DUMP.IGNORE.DIRS do (DREMOVE (MKATOM (U-CASE DIR))
DIRS))
DIRS])
(DUMP.DIRECTORY
[LAMBDA (HOST DIR IDATE NVERSIONS FILTERS LOG) (* drc: "25-Mar-86 13:03")
(* * Return all the files on DIR newer than IDATE, an IDATE, with no more than NVERSIONS of any particular file.
NIL versions means all. Files which match a filter on FILTERS (generated from by mapping DIRECTORY.MATCH.SETUP over
DUMP.IGNORE.SPECS) are removed.)
(LET* ((SPEC (PACKFILENAME 'HOST
HOST
'DIRECTORY
DIR
'BODY
'*.*;*))
(VALUE (NLSETQ (DUMP.GENERATE.NEWERTHAN SPEC IDATE)))
(FILES (if (LISTP VALUE)
then (CAR VALUE)
else (LET ((ERROR (ERRORN)))
(PRINTOUT T (ERRORSTRING (CAR ERROR))
" "
(CADR ERROR)
T SPEC " Not dumped." T)
(PRINTOUT LOG (ERRORSTRING (CAR ERROR))
" "
(CADR ERROR)
T SPEC " Not dumped." T))
NIL)))
(for FILE in (if NVERSIONS
then (DUMP.NVERSIONS FILES NVERSIONS)
else FILES)
when (for FILTER in FILTERS never (DIRECTORY.MATCH FILTER FILE)) collect
FILE])
(DUMP.GENERATE.NEWERTHAN
[LAMBDA (SPEC IDATE) (* drc: "21-Mar-86 22:05")
(RESETLST (* collect all the files in filespec SPEC newerthan
IDATE)
(bind FILE [GEN ←(\GENERATEFILES SPEC '(WRITEDATE)
'(RESETLST SORT)]
eachtime (SETQ FILE (\GENERATENEXTFILE GEN))
when (GEQ (IDATE (\GENERATEFILEINFO GEN 'WRITEDATE))
IDATE)
collect FILE until (NOT FILE])
(DUMP.NVERSIONS
[LAMBDA (FILES N) (* drc: " 1-Jan-01 00:36")
(* assumes FILES is sorted, with low versions first)
(DREVERSE (for TAIL on (DREVERSE FILES) bind FILE LASTFILE FILEFIELDS LASTFIELDS
(M ← 1)
eachtime (* Have to reverse list to get high versions first.)
(SETQ LASTFILE FILE)
(SETQ FILE (CAR TAIL))
(SETQ LASTFIELDS FILEFIELDS)
(SETQ FILEFIELDS (UNPACKFILENAME FILE))
(* only collect the first N of a particular file)
(if [AND (EQ (LISTGET FILEFIELDS 'NAME)
(LISTGET LASTFIELDS 'NAME))
(EQ (LISTGET FILEFIELDS 'EXTENSION)
(LISTGET LASTFIELDS 'EXTENSION))
(EQ (LISTGET FILEFIELDS 'DIRECTORY)
(LISTGET LASTFIELDS 'DIRECTORY]
then (SETQ M (ADD1 M))
else (SETQ M 1))
when (LEQ M N) collect FILE])
)
(RPAQ? DUMP.IGNORE.DIRS '(FONTS CLEARINGHOUSE SYSTEMFILES DESKTOPS))
(RPAQ? DUMP.IGNORE.SPECS '(*.DCOM;* *.SYSOUT;*))
(RPAQ? DUMP.DIRECTORY.SEPARATOR "\")
(PUTPROPS DUMPER COPYRIGHT ("Speech Input Project, Univ. of Edinburgh" 1986 1901))
(DECLARE: DONTCOPY
(FILEMAP (NIL (744 8397 (DUMP 754 . 2934) (DUMP.DUMP 2936 . 4062) (DUMP.NEW.FILENAME 4064 . 4735) (
DUMP.DIRECTORIES 4737 . 5478) (DUMP.DIRECTORY 5480 . 6683) (DUMP.GENERATE.NEWERTHAN 6685 . 7234) (
DUMP.NVERSIONS 7236 . 8395)))))
STOP