"{ Package: 'stx:libbasic2' }"

HierarchicalURI subclass:#FileURI
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'Resources'
!


!FileURI class methodsFor:'instance creation'!

fromFilename:aFilename
    "create an URI based on an a filename"

    ^ self new fromFilename:aFilename
! !

!FileURI class methodsFor:'accessing'!

schemes
    "answer the list of supported schemes"

    ^ #(file)
! !

!FileURI methodsFor:'converting'!

asFilename
    "answer the receiver represented as filename"

    ^ authority notNil ifTrue:[
        Filename remoteHost:authority rootComponents:pathSegments.
    ] ifFalse:[
        "kludge"
        (pathSegments first startsWith:$~) ifTrue:[
            pathSegments first asFilename construct:(Filename rootComponents:(pathSegments copyFrom:2)).
        ] ifFalse:[
            Filename rootComponents:pathSegments.
        ].
    ].

    "
        (URI fromString:'file:~/bla') asFilename
        (URI fromString:'file:~root/bla') asFilename 
    "
! !

!FileURI methodsFor:'initialize'!

fromFilename:aFilename
    "create an URI based on an a filename"

    |components|

    components := aFilename components.
    aFilename isAbsolute ifTrue:[
        (components size > 3 and:[(components at:2) size == 0]) ifTrue:[
            "this is a MS-Windows network path: \\host\path"
            authority := components at:3.
            pathSegments := components copyFrom:4.
        ] ifFalse:[
            "this is an absolute path"
            isAbsolute := true.
            pathSegments := components copyFrom:2.
        ].
    ] ifFalse:[
        "this is a relative path"
        isAbsolute := false.
        pathSegments := components.
    ]

    "
      self fromFilename:'/a/b/c'  asFilename   
      self fromFilename:'//a/b/c' asFilename  
      self fromFilename:'a/b/c'   asFilename    
    "
! !

!FileURI methodsFor:'queries'!

pathExists

    ^ self asFilename exists
! !

!FileURI methodsFor:'stream access'!

readStream

    ^ self asFilename readStream

    "
     'file:/etc/group' asURI readStream contents
     'file:/~/.profile' asURI readStream contents
     (URI fromString:'file:~/.profile') asFilename
     (URI fromString:'file:~/.profile') readStream upToEnd
    "
!

readStreamDo:aBlock
    "evaluate a block with the read stream as first argument
     and a dictionary containing attributes as second argument.
     The stream is closed after aBlock has been evaluated."

    |attributes file stream|

    attributes := self class attributes.
    file := self asFilename.
    attributes at:#fileSize put:(file fileSize).
    attributes at:#baseName put:file baseName.  
    attributes at:#uriInfo  put:self printString.  

    ^ [ 
        stream := file readStream.
        aBlock value:stream value:attributes
     ] ensure:[
        stream notNil ifTrue:[stream close]
     ].

    "
     'file:/etc/group' asURI readStreamDo:[:stream :attributes|
        stream contents         
                addFirst:attributes printString; 
                yourself
     ].
    "
!

readStreamsDo:aBlock
    "evaluate the block with a Collection of streams as first argument
     and a dictionary containing attributes as second argument,
     - a collection with a stream on a single file,
     - or a collection with streams on a directorie's files, but not recursive"

    self readStreamsDo:aBlock thenRemove:false.
!

readStreamsDo:aBlock thenRemove:doRemoveSource
    "evaluate the block with a Collection of streams as first argument
     and a dictionary containing attributes as second argument,
     - a collection with a stream on a single file,
     - or a collection with streams on a directorie's files, but not recursive"

    |attributes fn files list dirPath|

    fn := self path asFilename.
    files := OrderedCollection new.
    list := OrderedCollection new.
    attributes := self class attributes.

    fn isDirectory ifTrue:[
        dirPath := fn pathName.
        attributes at:#requestDirectory put:true.
        (DirectoryContents directoryNamed:dirPath) filesDo:[:aFile|
            files add:aFile
        ].
    ] ifFalse:[
        attributes at:#requestDirectory put:false.
        files add:fn.
    ].

    fn isDirectory ifFalse:[ |bName|
        bName := fn baseName.
        (bName startsWith:'*') ifTrue:[
            files removeAll.
            fn := fn directory.
            dirPath := fn pathName.
            attributes at:#requestDirectory put:true.
            (DirectoryContents directoryNamed:dirPath) filesDo:[:aFile|
                files add:aFile
            ].
        ].
        (bName startsWith:'*.') ifTrue:[ |rest|
            rest := bName restAfter:$*.
            (rest includesString:'*') ifTrue:[
                self error:'can''t resolve path:', self printString
            ].
            files := files select:[:aFile| aFile pathName endsWith:rest ]
        ].
    ].

    files do:[:aFile| |baseName stream|
        [
            baseName := aFile baseName.
            attributes at:#fileSize put:(aFile fileSize).
            attributes at:#baseName put:baseName.  
            (self pathSegements includes:baseName) ifTrue:[
                attributes at:#uriInfo put:self.  
            ] ifFalse:[ |uri col|
                uri := self copy.
                col := self pathSegements copy.
                col removeLast.
                col add:baseName.
                uri pathSegements:col.
                attributes at:#uriInfo put:uri.  
            ].
            stream := aFile readStream.
            aBlock value:stream value:attributes.
        ] ensure:[
            stream notNil ifTrue:[stream close]
        ].
        doRemoveSource == true ifTrue:[
            aFile remove
        ].
    ].

    "
        (URI fromString:'file:/home/tm/tmp') 
            readStreamsDo:[:stream :attributes | 
                Transcript showCR:(attributes at:#baseName).
                Transcript showCR:(attributes at:#fileSize).
                Transcript showCR:(attributes at:#requestDirectory).
                Transcript showCR:(attributes at:#uriInfo).
            ].
    "
!

writeStreamDo:aBlock
    "evaluate a block with the write stream as first argument
     and a dictionary containing attributes as second argument.
     The stream is closed after aBlock has been evaluated.
     Attributes may be the mime type (key #MIME)"

    |stream|

    ^ [
        stream := self asFilename writeStream.
        aBlock value:stream value:self class attributes
     ] ensure:[
        stream notNil ifTrue:[stream close]
     ].

    "
        (URI fromString:'file:/home/tm/tmp') 
            readStreamsDo:[:stream :attributes| 
                Transcript showCR:(attributes at:#MIME).
                Transcript showCR:(stream isWritable).
            ].
    "
!

writeStreamDo:aBlock create:doCreate

    ^ self writeStreamDo:aBlock create:doCreate atomic:false.
!

writeStreamDo:aBlock create:doCreate atomic:doAtomic
    "evaluate a block with the write stream as first argument
     and a dictionary containing attributes as second argument.
     The stream is closed after aBlock has been evaluated.
     Attributes may be the mime type (key #MIME)

     If doCreate is true, a nonExistent directory will be created.
     If doAtomic is true, files will appear atomically, by using
        an intermediate file theat will be renamed"

    |stream fileName toFileName|

    fileName := self asFilename.
    doAtomic ifTrue:[
        toFileName := fileName directory construct:'.transferFile'.
    ] ifFalse:[
        toFileName := fileName.
    ].
    [
        Stream streamErrorSignal handle:[:ex|
            doCreate ifFalse:[
                ex reject
            ].    
            fileName directory recursiveMakeDirectory.
            stream := toFileName writeStream.
        ] do:[
            stream := toFileName writeStream.
        ].
        aBlock value:stream value:self class attributes.
        doAtomic ifTrue:[
            toFileName moveTo:fileName.
        ]
    ] ensure:[
        stream notNil ifTrue:[stream close]
    ].

    "
        (URI fromString:'file:/home/tm/tmp') 
            readStreamsDo:[:stream :attributes| 
                Transcript showCR:(attributes at:#MIME).
                Transcript showCR:(stream isWritable).
            ].
    "
! !

!FileURI class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic2/FileURI.st,v 1.7 2003-07-11 12:46:51 stefan Exp $'
! !