"{ 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:[
        Filename rootComponents:pathSegments
    ].
! !

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

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|

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

    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:[
                attributes at:#uriInfo put:((self copy) addComponent:baseName).  
            ].
            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
    "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 fileName|

    fileName := self asFilename.
    [
        Stream streamErrorSignal handle:[:ex|
            doCreate ifFalse:[
                ex reject
            ].    
            (fileName directory) recursiveMakeDirectory.
            stream := fileName writeStream.
        ] do:[
            stream := fileName 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).
            ].
    "
! !

!FileURI class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic2/FileURI.st,v 1.3 2003-07-09 12:55:42 tm Exp $'
! !