"{ 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.

            stream := toFileName writeStream.

        ] do:[

            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

! !