'From Smalltalk/X, Version:3.1.9 on 9-sep-1997 at 11:55:40 pm'                  !

Filename subclass:#OpenVMSFilename

	instanceVariableNames:'osName'

	classVariableNames:'StandardSuffixTable'

	poolDictionaries:''

	category:'OS-OpenVMS'

!

Object subclass:#NameComponents

	instanceVariableNames:'volume directory filename'

	classVariableNames:''

	poolDictionaries:''

	privateIn:OpenVMSFilename

!

!OpenVMSFilename class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1997 by eXept Software AG

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    Filenames in OpenVMS.

    For your convenience, UNIX style filenames are converted

    to VMS format.

"

! !

!OpenVMSFilename class methodsFor:'initialization'!

initStandardSuffixTable

    "since there is no 'file' command to extract the type,

     return a guess based upon the files suffix. The following

     table defines what is returned."

    StandardSuffixTable := Dictionary new.

    #(  

	'COM'   'command procedure'

	'DIR'   'directory'

	'EXE'   'executable'

	'LIS'   'listing'

	'OBJ'   'object file'

	'TMP'   'temporary'

	'ADA'   'ADA source'

	'BAS'   'basic source'

	'C'     'c source'

	'COB'   'cobol source'

	'FOR'   'fortran source'

	'PAS'   'pascal source'

	'PL1'   'PL/1 source'

	'ST'    'smalltalk source'

	'STH'   'stc generated header'

    ) pairWiseDo:[:k :v |

	StandardSuffixTable at:k put:v

    ]

! !

!OpenVMSFilename class methodsFor:'instance creation'!

currentDirectory

    "return a filename for the current directory"

    ^ self named:'[]'

    "

     Filename currentDirectory

    "

!

rootDirectory

    "return a filename for the root directory"

    ^ self named:'[000000]'

    "

     Filename rootDirectory

    "

! !

!OpenVMSFilename class methodsFor:'parsing'!

components:aString

    "break a filenameString into path components.

     Cannot really do it, since applications assume, they can

     create a valid path by concatenating a dirName, the separator

     and a baseName."

    |idx|

    idx := (aString lastIndexOf:$]) max:(aString lastIndexOf:self separator).

    idx ~~ 0 ifTrue:[

	^ OrderedCollection 

		with:(aString copyTo:idx)

		with:(aString copyFrom:idx+1)

    ].

    ^ OrderedCollection with:aString

! !

!OpenVMSFilename methodsFor:'helpers'!

nameFromComponents:aComponentObject

    "concatenate the components, return a fileNameString"

    |sv sd sf s sep volume directory filename dcomps idx|

    volume := aComponentObject volume.

    directory := aComponentObject directory.

    filename := aComponentObject filename.

    volume notNil ifTrue:[

	sv := volume , ':'

    ] ifFalse:[

	sv := ''

    ].

    directory size > 0 ifTrue:[

	"/

	"/ strip of '-''s - if possible

	"/

	(directory includes:$-) ifTrue:[

	    dcomps := directory asCollectionOfSubstringsSeparatedBy:$..

	    [(idx := dcomps indexOf:'-') > 1] whileTrue:[

		((dcomps at:(idx-1)) ~= '-') ifTrue:[

		    dcomps := (dcomps copyTo:(idx-2)) , (dcomps copyFrom:idx+1)

		]

	    ].

	    directory := dcomps asStringWith:$.

	].

	sd := '[' , directory , ']'

    ] ifFalse:[

	sd := ''

    ].

    filename size > 0 ifTrue:[

	"/

	"/ soon no longer needed - I never create UNIX names

	"/ internally ...

	"/

	(filename includesAny:'/\') ifTrue:[

	    (filename includes:$/) ifTrue:[

		"/ a UNIX component given ...

		sep := $/

	    ] ifFalse:[

		"/ an MSDOS component given ...

		sep := $\

	    ].

	    "/ special hack - convert UNIX/MSDOS path to VMS conventions

	    (filename startsWith:sep) ifTrue:[

		"/ mhm that should not happen ...

		filename := filename copyFrom:2

	    ].

	    (filename endsWith:sep) ifTrue:[

		"/ mhm that should not happen ...

		filename := filename copyWithoutLast:1

	    ].

	    dcomps := filename asCollectionOfSubstringsSeparatedBy:sep.

	    sf := dcomps last.

	    dcomps := dcomps copyWithoutLast:1.

	    dcomps := dcomps 

			collect:[:aDirComponent |

				    aDirComponent = '..' ifTrue:[

					'-'

				    ] ifFalse:[

					aDirComponent

				    ]

				].                  

	    directory size > 0 ifTrue:[

		sd := '[' , directory , '.' , (dcomps asStringWith:$.) , ']'.

	    ] ifFalse:[

		sd := '[' , (dcomps asStringWith:$.) , ']'.

	    ]

	] ifFalse:[

	    sf := filename

	]

    ] ifFalse:[

	sf := ''

    ].

    s := sv, sd, sf.

    s isEmpty ifTrue:[

	^ '[]'

    ].

    ^ s

    "Modified: 9.9.1997 / 09:38:41 / cg"

!

parseComponentsFrom:aString makeRelative:makeRelative

    "given a pathName, decompose into volume, directory & filename.

     Return the components as a componentObject (which is a dump

     container for those components).

     Beside parsing VMS filenames, this also detects UNIX and MSDOS

     names and tries to convert them into VMS format - however,

     in your applications you probably should not depend on this

     to work out correctly every time. To make certain, only

     provide relative UNIX/MSDOS pathnames (if at all)."

    |nameString v d f idx0 idx idx1 idx2 dcomps sep abs len|

    nameString := aString.

    "/

    "/ hack - allow Unix names ...

    "/

    nameString = '.' ifTrue:[

	"/ 'OpenVMSFilename [warning]: use of Unix name: ''.''' infoPrintCR.

	nameString := '[]'.

    ] ifFalse:[

	nameString = '..' ifTrue:[

	    "/ 'OpenVMSFilename [warning]: use of Unix name: ''..''' infoPrintCR.

	    nameString := '[-]'.

	] ifFalse:[

	     nameString = '/' ifTrue:[

		"/ 'OpenVMSFilename [warning]: use of Unix name: ''/''' infoPrintCR.

		nameString := '[000000]'.

	    ]

	]

    ].

    "/

    "/ a unix or msdos filename - convert.

    "/

    (nameString includesAny:'/\') ifTrue:[

	(nameString includes:$/) ifTrue:[

	    "/ a UNIX component given ...

	    sep := $/

	] ifFalse:[

	    "/ an MSDOS component given ...

	    sep := $\

	].

	"/ although not a legal VMS name,

	"/ we support the form volume:<unixPath>

	"/ this makes your life easier in the FileBrowser

	"/ or FileEntry dialogs. However, you should not

	"/ place such filenames into your program, since

	"/ those are not compatible with UNIX/MSDOS conventions

	"/ i.e. that should be used for user-entered pathNames only.

	"/

	idx1 := nameString indexOf:sep.

	idx2 := nameString indexOf:$:.

	idx2 ~~ 0 ifTrue:[

	    idx2 < idx1 ifTrue:[

		"/

		"/ something like:

		"/   volume:<unixPath>

		"/

		v := nameString copyTo:idx2-1.

		nameString := nameString copyFrom:idx2+1.

		idx1 := nameString indexOf:$/.

	    ]

	].

	abs := false.

	(nameString startsWith:sep) ifTrue:[

	    abs := true.

	    nameString := nameString copyFrom:2.

	    [nameString startsWith:sep] whileTrue:[

		nameString := nameString copyFrom:2.

	    ]

	].

	[nameString size > 2

	 and:[(nameString at:1) == $.

	 and:[(nameString at:2) == sep]]] whileTrue:[

	    nameString := nameString copyFrom:3.

	].

	dcomps := nameString asCollectionOfSubstringsSeparatedBy:$/.

	"/

	"/ replace '..' by '-'

	"/

	f := dcomps last.

	dcomps := dcomps copyWithoutLast:1.

	dcomps size > 0 ifTrue:[

	    dcomps replaceAll:'..' with:'-'.

	    d := dcomps asStringWith:$..

	    abs ifFalse:[

		makeRelative ifTrue:[

		    d := '.' , d

		]

	    ].

	    nameString := '[' , d , ']' , f

	] ifFalse:[

	    nameString := f

	]

    ].

    nameString = '[]' ifTrue:[

	"/ replace by currentDirectory

	nameString := OperatingSystem pathNameOf:'[]'

    ].

    len := nameString size.

    "/

    "/ is there a volume ?

    "/

    idx := nameString indexOf:$:.

    idx ~~ 0 ifTrue:[

	v := nameString copyTo:idx - 1.

	"/ eat up any additional colons

	[(idx < len) and:[(nameString at:idx+1)==$:]] whileTrue:[

	    idx := idx + 1

	]

    ].

    idx := idx + 1.

    idx > len ifTrue:[

	"/

	"/ a volume alone; i.e.

	"/ something like: 'volume:'

	"/

    ] ifFalse:[

	d := ''.

	[(idx < len)

	 and:[(nameString at:idx) == $[ ]] whileTrue:[

	    idx0 := idx + 1.

	    idx := nameString indexOf:$] startingAt:idx0.

	    idx == 0 ifTrue:[

		"/ mhmh - malformed. what should we do here ?

		self error:'malformed filename'

	    ].

	    d isEmpty ifTrue:[

		d := nameString copyFrom:idx0 to:(idx-1).

	    ] ifFalse:[

		(d endsWith:$.) ifTrue:[

		    d := d , (nameString copyFrom:idx0 to:(idx-1)).

		] ifFalse:[

		    d := d , '.' , (nameString copyFrom:idx0 to:(idx-1)).

		]

	    ].

	    idx := idx + 1.

	    "/ eat up any additional colons

	    [(idx <= len) and:[(nameString at:idx)==$:]] whileTrue:[

		idx := idx + 1

	    ]

	].

	f := nameString copyFrom:idx.

	"/ if the directory starts with '000000.', cut it off

	(d startsWith:'000000.') ifTrue:[

	    d := d copyFrom:8

	].

	"/ check if the filename component has multiple '.'

	"/ characters in it; if so, translate them into

	"/ underscore characters (except for the last one).

	f size > 0 ifTrue:[

	    (f occurrencesOf:$.) > 1 ifTrue:[

		f replaceAll:$. with:$_ from:1 to:(f lastIndexOf:$.)-1.

	    ]

	].

    ].

    ^ NameComponents basicNew volume:v directory:d filename:f

    "Modified: 9.9.1997 / 08:50:04 / cg"

!

parseComponentsFrom:aString

    "given a pathName, decompose into volume, directory & filename.

     Return the components as a componentObject (which is a dump

     container for those components).

     Beside parsing VMS filenames, this also detects UNIX and MSDOS

     names and tries to convert them into VMS format - however,

     in your applications you probably should not depend on this

     to work out correctly every time. To make certain, only

     provide relative UNIX/MSDOS pathnames (if at all)."

    ^ self

	parseComponentsFrom:aString

	makeRelative:true

! !

!OpenVMSFilename class methodsFor:'queries'!

defaultTempDirectoryName

    "return the default temp directory as a filename.

     Here, the presence of a sys$tmp: or sys$scratch: volume

     is checked, and if so, returned. Otherwise, the current directory

     is returned.

     This is used, if no special preferences were defined in

     any of the TEMP-environment variables (see tempDirectory)."

    #( 'sys$tmp:[000000]' 'sys$scratch:[000000]')

    do:[:try |

	|fn|

	fn := try asFilename.

	(fn isDirectory 

	and:[fn canBeWritten

	and:[fn isReadable]]) ifTrue:[

	    ^ try

	]

    ].

    "/ fallBack - use current.

    ^ '.'

    "

     OpenVMSFilename defaultTempDirectoryName

    "

!

directorySuffix

    "Return the suffix for directories.

     In VMS, all directories have a '.dir' extension."

    ^ 'DIR'

!

isBadCharacter:aCharacter

    "return true, if aCharacter is unallowed in a filename."

    ('/\' includes:aCharacter) ifTrue:[^ true].

    ^ super isBadCharacter:aCharacter

    "Created: 8.9.1997 / 00:14:47 / cg"

!

isCaseSensitive

    "return true, if filenames are case sensitive.return true, if filenames are case sensitive."

    ^ false

!

maxComponentLength

    "return the maximum number of characters a filename component

     may have in VMS"

    ^ 39

!

maxLength

    "return the maximum number of characters a filename may have in VMS"

    ^ 1024

!

separator

    "return the file/directory separator.

     For openVMS, the separator concept does not really fit,

     since names are composed as 'volume:[dir.dir.dir]file.ext'."

     ^ $.

     "

      Filename concreteClass separator  

     "

    "Created: 8.9.1997 / 00:17:28 / cg"

    "Modified: 9.9.1997 / 08:51:01 / cg"

!

tempFileNameTemplate

    "return a template for temporary files.

     This is expanded with the current processID and a sequenceNumber

     to generate a unique filename."

    ^ 'AAA_%1_%2.DIR'

    "Created: 8.9.1997 / 00:01:46 / cg"

    "Modified: 8.9.1997 / 00:29:23 / cg"

! !

!OpenVMSFilename methodsFor:'file queries'!

fileType

    "this returns a string describing the type of contents of

     the file. Here, the suffix is examined for a standard

     suffix and an appropriate string is returned.

     Poor VMS - no file command."

    |suff type info fmt|

    StandardSuffixTable isNil ifTrue:[

	self class initStandardSuffixTable

    ].

    suff := self suffix asUppercase.

    type := StandardSuffixTable at:suff ifAbsent:nil.

    type isNil ifTrue:[