"{ 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'!

exists

    ^ 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 renameBlock:nil.
!

readStreamsDo:aBlock renameBlock:renameBlock
    "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 directories files, but not recursive"

    |attributes fn files list baseName|

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

    fn isDirectory ifTrue:[
        attributes at:#requestDirectory put:true.
        fn directoryContentsAsFilenamesDo:[:eachFilename|
            eachFilename isDirectory ifFalse:[
                files add:eachFilename
            ].
        ].
    ] ifFalse:[
        baseName := fn baseName.
        (baseName includesAny:'*?[]') ifTrue:[ |directoryName|
            attributes at:#requestDirectory put:true.
            directoryName := fn directory.
            directoryName directoryContentsDo:[:eachFilenameString|
                (baseName match:eachFilenameString) ifTrue:[ |filename|
                    filename := directoryName construct:eachFilenameString.
                    filename isDirectory ifFalse:[
                        files add:(directoryName construct:eachFilenameString).
                    ].
                ].
            ].
        ] ifFalse:[
            attributes at:#requestDirectory put:false.
            files add:fn.
        ].
    ].

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

        renameBlock notNil ifTrue:[ |renameFilenameString|
            renameFilenameString := renameBlock value:eachFilename pathName.
            renameFilenameString asFilename exists ifTrue:[
                renameFilenameString := renameFilenameString, '.', 
                        (AbsoluteTime now printStringFormat:'%(year)%(mon)%(day)%h%m%s').
            ].
            eachFilename moveTo:renameFilenameString.
        ].
    ].

    "
        (URI fromString:'file:~/test/out') 
            readStreamsDo:[:stream :attributes | 
                Transcript showCR:(attributes at:#baseName).
                Transcript showCR:(attributes at:#fileSize).
                Transcript showCR:(attributes at:#requestDirectory).
                Transcript showCR:(attributes at:#uriInfo).
            ].
        (URI fromString:'file:~/test/out/*1') 
            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.
    toFileName := fileName.
    doAtomic ifTrue:[
        fileName isDirectory ifFalse:[
            toFileName := fileName directory.
        ].
        toFileName := toFileName construct:'.transferFile'.
    ].
    [
        Stream streamErrorSignal handle:[:ex|
            doCreate ifFalse:[
                ex reject
            ].    
            fileName directory recursiveMakeDirectory.
            self exists ifTrue:[ |infoStream|
                infoStream := '' writeStream.
                self publicPrintOn:infoStream.
                self error:('Local write: Datei %1 already exists!!' bindWith:infoStream contents).
            ].
            stream := toFileName writeStream.
        ] do:[
            self exists ifTrue:[ |infoStream|
                infoStream := '' writeStream.
                self publicPrintOn:infoStream.
                self error:('Local write: Datei %1 already exists!!' bindWith:infoStream contents).
            ].
            stream := toFileName writeStream.
        ].
        aBlock value:stream value:self class attributes.
        stream close.
        doAtomic ifTrue:[
            toFileName moveTo:fileName.
        ]
    ] ifCurtailed:[
        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.9 2003-07-24 09:29:43 tm Exp $'
! !