home *** CD-ROM | disk | FTP | other *** search
- /*--------------------------------------------------------*
-
- Fill V1.2a. Floppy Storage Optimizer.
- Copyright ©1993-1994 Barry Wills. All rights reserved.
-
- *--------------------------------------------------------*/
-
- MODULE 'dos/dos',
- 'libraries/arpbase',
- 'arp'
-
- PMODULE 'PMODULES:commandLineArgs'
- PMODULE 'PMODULES:upperChar'
-
- /*-- Runtime exceptions. --*/
- ENUM ER_NONE,
- ER_OPEN_ARPLIBRARY,
- ER_USAGE,
- ER_DEST_LOCK,
- ER_SOURCE_LOCK,
- ER_SOURCE_SPEC,
- ER_SOURCE_EXAM,
- ER_DEST_EXAM,
- ER_DEST_INFO,
- ER_FILES_TOO_LARGE,
- ER_MEM,
- ER_WONT_FIT,
- ER_USER_ABORT
-
- RAISE ER_MEM IF New()=NIL,
- ER_MEM IF String()=NIL,
- ER_USER_ABORT IF CtrlC()=TRUE
-
- CONST SIZEOF_A_FILE_BLOCK=35136,
- NUMBLOCKS_USED_ON_BLANK_DISK_AMIGA_880K=2,
- NUMBLOCKS_USED_ON_BLANK_DISK_IBM_720K=14
-
- /*=== List definitions. ==================================================*/
-
- OBJECT fl_ElementType
- fileName :LONG /* PTR TO CHAR */
- fileSize :LONG /* LONG */
- fileProtection:LONG /* LONG */
- days :LONG
- minute :LONG
- tick :LONG
- ENDOBJECT
- /* fl_ElementType */
-
- OBJECT fl_NodeType
- element :LONG /* PTR TO fl_ElementType */
- nextNode:LONG /* PTR TO fl_NodeType */
- ENDOBJECT
- /* fl_NodeType */
-
- OBJECT fl_ListType
- head :LONG /* all PTR TO fl_NodeType */
- tail :LONG
- current:LONG
- ENDOBJECT
- /* fl_ListType */
-
-
- /*=== Command-line argument defs. ========================================*/
-
- CONST MAX_ARG_ERRORMARGIN=20,
- MAX_DEPTH_OF_COMPARISON=2
-
- DEF optionIsSet_CopyOnly=FALSE,
- optionIsSet_Clone=TRUE,
- optionIsSet_NoPro=FALSE,
- argErrorMargin=0,
- argSourceSpec=NIL,
- argDestPath=NIL,
- argNoDosOverHead=FALSE,
- sourceDir[108]:STRING,
- sourcePathAndFilename[108]:STRING,
- destPathAndFilename[108]:STRING,
- numblocksUsedOnABlankDisk=NUMBLOCKS_USED_ON_BLANK_DISK_AMIGA_880K
-
- DEF dosCopy_segList,
- dosCopy_args,
- stackSize
-
-
- /*=== Command-line Argument Parser =======================================*/
-
- PROC getSourceDir()
- DEF c
- c:=StrLen(argSourceSpec)
- WHILE (c-->0) AND (argSourceSpec[c]<>":") AND (argSourceSpec[c]<>"/") DO NOP
- IF c=0
- SetStr(sourceDir, 0)
- ELSE
- INC c
- WHILE c-->=0 DO sourceDir[c]:=argSourceSpec[c]
- SetStr(sourceDir, StrLen(sourceDir))
- ENDIF
- ENDPROC
- /* getSourceDir */
-
- PROC parseCommandLineArguments()
- DEF index=1, char, theArg:PTR TO CHAR
- theArg:=String(StrLen(arg))
- WHILE getArg(theArg, index)
- INC index
- char:=theArg[0]
- IF char="-"
- char:=theArg[1]
- SELECT char
- CASE "c"
- optionIsSet_CopyOnly:=TRUE
- CASE "x"
- optionIsSet_Clone:=FALSE
- CASE "p"
- optionIsSet_NoPro:=TRUE
- CASE "e"
- argErrorMargin:=Val(theArg+2, NIL)
- IF argErrorMargin<=0 THEN Raise(ER_USAGE)
- IF argErrorMargin>MAX_ARG_ERRORMARGIN THEN argErrorMargin:=MAX_ARG_ERRORMARGIN
- CASE "n"
- argNoDosOverHead:=TRUE
- numblocksUsedOnABlankDisk:=NUMBLOCKS_USED_ON_BLANK_DISK_IBM_720K
- ENDSELECT
- ELSEIF argSourceSpec=NIL
- argSourceSpec:=String(StrLen(theArg))
- StrCopy(argSourceSpec, theArg, ALL)
- ELSEIF argDestPath=NIL
- argDestPath:=String(StrLen(theArg))
- StrCopy(argDestPath, theArg, ALL)
- ELSE /*-- Too many args. --*/
- Raise(ER_USAGE)
- ENDIF
- ENDWHILE
- IF (argSourceSpec=NIL) OR (argDestPath=NIL) THEN Raise(ER_USAGE)
- DisposeLink(theArg)
- getSourceDir()
- ENDPROC
- /* parseCommandLineArguments */
-
-
- /*=== Begin File List Implementation =====================================*/
-
- /*------------------------------------------------------------------------*
- These functions are used to gain easy access to the list substructures.
- *------------------------------------------------------------------------*/
-
- PROC fl_FileSizeFrom(theElement:PTR TO fl_ElementType) RETURN theElement.fileSize
- PROC fl_ElementFrom(theNode:PTR TO fl_NodeType) RETURN theNode.element
- PROC fl_NextNodeFrom(theNode:PTR TO fl_NodeType) RETURN theNode.nextNode
- PROC fl_IsLessThan(thisElement, thatElement) RETURN fl_FileSizeFrom(thisElement)<
- fl_FileSizeFrom(thatElement)
- PROC fl_IsEmpty(list:PTR TO fl_ListType) RETURN fl_NextNodeFrom(list.head)=list.tail
-
- /*------------------------------------------------------------------------*
- These functions are used to manipulate the list.
- *------------------------------------------------------------------------*/
-
- PROC fl_New()
- DEF newFileList:PTR TO fl_ListType,
- head:PTR TO fl_NodeType,
- tail:PTR TO fl_NodeType
- newFileList:=New(SIZEOF fl_ListType)
- newFileList.head:=New(SIZEOF fl_NodeType)
- newFileList.tail:=New(SIZEOF fl_NodeType)
- head:=newFileList.head
- tail:=newFileList.tail
- head.nextNode:=newFileList.tail
- tail.nextNode:=NIL
- head.element:=NIL
- tail.element:=NIL
- newFileList.current:=newFileList.head
- ENDPROC newFileList
- /* fl_New */
-
- PROC fl_Insert(element:PTR TO fl_ElementType, list:PTR TO fl_ListType)
- DEF newNode:PTR TO fl_NodeType,
- current:PTR TO fl_NodeType,
- newElement:PTR TO fl_ElementType
- list.current:=list.head
- WHILE (fl_NextNodeFrom(list.current)<>list.tail) AND
- fl_IsLessThan(element, fl_ElementFrom(fl_NextNodeFrom(list.current)))
- list.current:=fl_NextNodeFrom(list.current)
- ENDWHILE
- current:=list.current
- newNode:=New(SIZEOF fl_NodeType)
- newNode.element:=New(SIZEOF fl_ElementType)
- newElement:=newNode.element
- newElement.fileName:=element.fileName
- newElement.fileSize:=element.fileSize
- newElement.fileProtection:=element.fileProtection
- newElement.days:=element.days
- newElement.minute:=element.minute
- newElement.tick:=element.tick
- element.fileName:=NIL /*-- detach pointer so that list owns it --*/
- newNode.nextNode:=current.nextNode
- current.nextNode:=newNode
- ENDPROC TRUE
- /* fl_Insert */
-
- PROC fl_RetrieveFirst(list:PTR TO fl_ListType)
- IF fl_IsEmpty(list) THEN RETURN NIL
- list.current:=fl_NextNodeFrom(list.head)
- ENDPROC fl_ElementFrom(list.current)
- /* fl_RetrieveFirst */
-
- PROC fl_RetrieveNext(list:PTR TO fl_ListType)
- IF fl_IsEmpty(list) THEN RETURN NIL
- IF fl_NextNodeFrom(list.current)=list.tail THEN RETURN NIL
- list.current:=fl_NextNodeFrom(list.current)
- ENDPROC fl_ElementFrom(list.current)
- /* fl_RetrieveNext */
-
- PROC fl_RemoveCurrent(list:PTR TO fl_ListType)
- DEF current:PTR TO fl_NodeType,
- node:PTR TO fl_NodeType,
- element:PTR TO fl_ElementType
- IF fl_IsEmpty(list) THEN RETURN NIL
- /*-- find node --*/
- IF list.current=list.head THEN RETURN NIL
- /*-- current undefined; must call one --*/
- /*-- of the functions that set current. --*/
- IF list.current=list.tail THEN RETURN NIL
- /*-- At end of list. --*/
- current:=list.head
- WHILE current.nextNode<>list.current DO current:=current.nextNode
- /*-- detach node --*/
- node:=list.current
- current.nextNode:=node.nextNode
- list.current:=current /*-- set up for possible subsequent call to fl_RetrieveNext. --*/
- /*-- remove element and deallocate node --*/
- element:=node.element
- Dispose(node)
- ENDPROC element
- /* fl_RemoveCurrent */
-
- /*=== End File List Implementation =======================================*/
-
-
- PROC enoughRoomOnDest(theDestInfo:PTR TO infodata, theElement:PTR TO fl_ElementType)
- DEF numBytesFree, numBytesRequired, numFileExtensionBlocks,
- numBytesForFileExtensionBlocks
- IF theElement=NIL THEN RETURN FALSE
- /*-- Compute what DOS says is free. --*/
- numBytesFree:=Mul(theDestInfo.numblocks-theDestInfo.numblocksused,
- theDestInfo.bytesperblock)
- IF argNoDosOverHead
- numBytesRequired:=theElement.fileSize
- ELSE
- /*------------------------------------------*
- Storage required by DOS filesystem =
- file_size_in_bytes +
- one_block_for_file_header +
- number_file_extension_blocks_required *
- bytes_per_block
- *------------------------------------------*/
- numFileExtensionBlocks:=Div(theElement.fileSize, SIZEOF_A_FILE_BLOCK)+1
- numBytesForFileExtensionBlocks:=Mul(numFileExtensionBlocks,
- theDestInfo.bytesperblock)
- numBytesRequired:=theElement.fileSize+ /* file size */
- theDestInfo.bytesperblock+ /* file header */
- numBytesForFileExtensionBlocks+ /* extension blocks */
- (argErrorMargin*theDestInfo.bytesperblock)
- ENDIF
- /*-- LEAVE THESE IN JUST IN CASE SOMEONE REPORTS ERRORS ------------------*
- WriteF('\n\nfilename \s', theElement.fileName)
- WriteF('\n filesize \d', theElement.fileSize)
- WriteF('\n numblocks \d', theDestInfo.numblocks)
- WriteF('\n numblocksused \d', theDestInfo.numblocksused)
- WriteF('\n bytesperblock \d', theDestInfo.bytesperblock)
- WriteF('\n numbytesfree \d', numBytesFree)
- WriteF('\n numFileExtensionBlocks \d', numFileExtensionBlocks)
- WriteF('\n numBytesForFileExtensionBlocks \d', numBytesForFileExtensionBlocks)
- WriteF('\n numBytesRequired \d', numBytesRequired)
- Raise(0)
- *------------------------------------------------------------------------*/
- ENDPROC numBytesRequired<=numBytesFree
- /* enoughRoomOnDest */
-
- PROC moveFile(theElement:PTR TO fl_ElementType) HANDLE
- DEF rc, sLock=NIL, dLock=NIL, sFib:fileinfoblock, dFib:fileinfoblock
- StringF (sourcePathAndFilename, '\s\s', sourceDir, theElement.fileName)
- StringF (destPathAndFilename, '\s\s\s',
- argDestPath,
- IF Char(argDestPath+StrLen(argDestPath)-1)=":" THEN '' ELSE '/',
- theElement.fileName)
- WriteF ('\n \s \s ...',
- IF optionIsSet_CopyOnly THEN 'Copying' ELSE 'Moving',
- sourcePathAndFilename)
- IF dosCopy_args=NIL THEN dosCopy_args:=String(512)
- StringF(dosCopy_args, '\s \s\s\s QUIET\n',
- sourcePathAndFilename, destPathAndFilename,
- IF optionIsSet_Clone THEN ' CLONE' ELSE '',
- IF optionIsSet_NoPro THEN ' NOPRO' ELSE '')
- rc:=RunCommand(dosCopy_segList, stackSize, dosCopy_args, StrLen(dosCopy_args))
- IF rc=-1
- Raise("STAK")
- ELSE
- rc:=IoErr()
- IF (sLock:=Lock(sourcePathAndFilename, SHARED_LOCK))=NIL THEN Raise(ER_SOURCE_LOCK)
- IF Examine(sLock, sFib)=FALSE THEN Raise(ER_SOURCE_EXAM)
- IF (dLock:=Lock(destPathAndFilename, SHARED_LOCK))=NIL
- Raise(IF rc=0 THEN ER_USER_ABORT ELSE ER_WONT_FIT)
- ELSE
- IF Examine(dLock, dFib)=FALSE THEN Raise(ER_DEST_EXAM)
- IF dFib.size<>sFib.size
- IF rc=0 THEN Raise(ER_USER_ABORT)
- Raise(ER_WONT_FIT)
- ENDIF
- ENDIF
- ENDIF
- UnLock(sLock)
- UnLock(dLock)
- IF optionIsSet_CopyOnly
- WriteF(' copied.')
- ELSE
- DeleteFile(sourcePathAndFilename)
- WriteF(' moved.')
- ENDIF
- EXCEPT
- IF sLock THEN UnLock(sLock)
- IF dLock THEN UnLock(dLock)
- DeleteFile(destPathAndFilename)
- IF exception=ER_WONT_FIT
- WriteF('\n didn\at fit. Trying a smaller one.')
- RETURN FALSE
- ELSE
- Raise(exception)
- ENDIF
- ENDPROC TRUE
- /* moveFile */
-
- PROC ds_daysFrom(dateStamp:PTR TO datestamp) RETURN dateStamp.days
- PROC ds_minuteFrom(dateStamp:PTR TO datestamp) RETURN dateStamp.minute
- PROC ds_tickFrom(dateStamp:PTR TO datestamp) RETURN dateStamp.tick
-
- PROC loadDosCopyCommand()
- IF (dosCopy_segList:=LoadSeg('C:Copy'))=NIL THEN Raise("LSEG")
- stackSize:=4000
- ENDPROC
- /* loadDosCopyCommand */
-
- PROC unloadDosCopyCommand()
- IF dosCopy_segList THEN UnLoadSeg(dosCopy_segList)
- ENDPROC
- /* unloadDosCopyCommand */
-
- PROC main() HANDLE
- DEF anchorPath:anchorpath, /* Arp object. */
- sourceFib:fileinfoblock,
- destLock=NIL,
- destInfo:infodata,
- fileList:PTR TO fl_ListType,
- element:PTR TO fl_ElementType,
- sourceFindSuccess, fileName,
- checkingForFile, char, newDisk=TRUE, filesMoved=0
- '$VER: Fill 1.2a (5.24.94)'
- WriteF('\n Fill V1.2a. Floppy Storage Optimizer.' +
- '\n Copyright ©1993-1994 Barry Wills. All rights reserved.')
- /*-- Init external support. --*/
- IF (arpbase:=OpenLibrary('arp.library', 39))=NIL THEN Raise(ER_OPEN_ARPLIBRARY)
- loadDosCopyCommand()
- /*-- Get command line arguments. --*/
- IF arg[]=0 THEN Raise(ER_USAGE)
- fileList:=fl_New()
- parseCommandLineArguments()
- /*-- Check destination validity. --*/
- IF (destLock:=Lock(argDestPath, SHARED_LOCK))=NIL THEN Raise(ER_DEST_LOCK)
- /*-- Check source validity. --*/
- anchorPath.breakbits:=SIGBREAKF_CTRL_C /*-- Arp: allow user to abort. --*/
- anchorPath.strlen:=0
- IF (sourceFindSuccess:=FindFirst(argSourceSpec, anchorPath))<>0 THEN Raise (ER_SOURCE_SPEC)
- /*-- Get source file list. --*/
- WriteF('\n\n Getting file list.')
- /*-- Put filenames and sizes in a list, sorted on filesize by fl_Insert(). --*/
- WHILE sourceFindSuccess=0
- sourceFib:=anchorPath.info
- IF sourceFib.direntrytype<0
- /*fileName:=String(108)*/
- fileName:=String(StrLen(sourceFib.filename))
- StrCopy(fileName, sourceFib.filename, ALL)
- fl_Insert([fileName, sourceFib.size, sourceFib.protection,
- ds_daysFrom(sourceFib.datestamp),
- ds_minuteFrom(sourceFib.datestamp),
- ds_tickFrom(sourceFib.datestamp)],
- fileList)
- ENDIF
- sourceFindSuccess:=FindNext(anchorPath)
- ENDWHILE
- /*-- Finished with ARP. --*/
- FreeAnchorChain(anchorPath); anchorPath:=NIL
- CloseLibrary(arpbase); arpbase:=NIL
- /*-- Move files. --*/
- WHILE fl_IsEmpty(fileList)=FALSE
- IF newDisk OR (element=NIL)
- element:=fl_RetrieveFirst(fileList)
- newDisk:=FALSE
- filesMoved:=0
- WriteF('\n')
- ELSE
- element:=fl_RetrieveNext(fileList)
- ENDIF
- IF Info(destLock, destInfo)=FALSE THEN Raise(ER_DEST_INFO)
- checkingForFile:=TRUE
- WHILE checkingForFile
- IF element=NIL
- checkingForFile:=FALSE
- ELSEIF enoughRoomOnDest(destInfo, element)
- checkingForFile:=FALSE
- ELSE
- element:=fl_RetrieveNext(fileList)
- ENDIF
- ENDWHILE
- IF element<>NIL
- element:=fl_RemoveCurrent(fileList)
- moveFile(element)
- INC filesMoved
- Dispose(element)
- ELSEIF destInfo.numblocksused=numblocksUsedOnABlankDisk
- Raise(ER_FILES_TOO_LARGE)
- ELSE
- /*-- Disk filled; prompt for another. --*/
- WriteF('\n\s', IF filesMoved THEN '' ELSE '\nNo files moved/copied.')
- WriteF('\nUnused bytes = \d.',
- Mul(destInfo.numblocks-destInfo.numblocksused,
- destInfo.bytesperblock))
- WriteF('\nInsert next volume. Press RETURN to proceed, \aQ\a or \aq\a to discontinue...')
- char:=Inp(stdout)
- IF char<>10 THEN WHILE Inp(stdout)<>10 DO NOP
- IF upperChar(char)="Q" THEN Raise(ER_USER_ABORT)
- UnLock(destLock)
- IF (destLock:=Lock(argDestPath, SHARED_LOCK))=NIL THEN Raise(ER_DEST_LOCK)
- newDisk:=TRUE
- ENDIF
- ENDWHILE
- /*-- Display unused bytes on destination before leaving program. --*/
- IF Info(destLock, destInfo)=FALSE THEN Raise(ER_DEST_INFO)
- WriteF('\n\nUnused bytes = \d.',
- Mul(destInfo.numblocks-destInfo.numblocksused, destInfo.bytesperblock))
- /*-- Clean up. --*/
- UnLock(destLock)
- unloadDosCopyCommand()
- WriteF('\n\n')
- CleanUp(0);
- EXCEPT
- WriteF('\n\n')
- SELECT exception
- CASE ER_OPEN_ARPLIBRARY;
- WriteF('Error opening arp.library V39+')
- CASE ER_USAGE
- WriteF(' Usage: Fill [<options>] <source> <dest>' +
- '\n <source> Any valid DOS "dev:dir/filepat", ARP wildcards supported' +
- '\n <dest> Any valid DOS "dev:dir"' +
- '\n [<options>]' +
- '\n -c Copy files only, don''t delete source (default MOVE FILES)' +
- '\n -e## Error margin, add blocks to storage estimate (1-\d; default 0)' +
- '\n -n No DOS overhead considerations (use on MS-DOS floppies)' +
- '\n -p Don''t transfer protection bits (use standard rwed)' +
- '\n -x Don''t clone protection bits, date, and time',
- MAX_ARG_ERRORMARGIN)
- CASE ER_DEST_LOCK; WriteF(' *** Destination \s does not exist', argDestPath)
- CASE ER_SOURCE_SPEC; WriteF(' *** No entries found')
- CASE ER_MEM; WriteF(' *** Insufficient memory')
- CASE ER_DEST_INFO; WriteF(' *** Error occurred while getting destination Info')
- CASE ER_FILES_TOO_LARGE
- WriteF(' *** Remaining file(s) too large to fit on destination')
- CASE ER_USER_ABORT; WriteF(' *** Program aborted by request')
- CASE "LSEG"; WriteF(' *** Could not load DOS Copy command')
- CASE "STAK"; WriteF(' *** Out of stack space')
- DEFAULT; WriteF(' *** ERROR: result \d', exception)
- ENDSELECT
- IF destLock THEN UnLock(destLock)
- unloadDosCopyCommand()
- /*-- Arp stuff. --*/
- IF anchorPath THEN FreeAnchorChain(anchorPath)
- IF arpbase THEN CloseLibrary(arpbase)
- WriteF('\n\n')
- CleanUp(RETURN_WARN);
- ENDPROC
-