"{ Package: 'stx:libbasic2' }"

HierarchicalURI subclass:#FtpURI

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'Resources'

!

!FtpURI class methodsFor:'accessing'!

schemes

    ^ #(ftp)

! !

!FtpURI methodsFor:'defaults'!

defaultPassword

    ^ 'secret@secret'

!

defaultPort

    "answer the default command-port here"

    ^ 21

!

defaultUser

    ^ 'anonymous'

! !

!FtpURI methodsFor:'ftp requests'!

connectThenDo:aOneArgBlock

    |ftp|

    ftp := FTPClient new.

    [

        ftp connectTo:self host 

            port:self port 

            user:(self user ? self defaultUser)

            password:(self password ? self defaultPassword).

        aOneArgBlock value:ftp

    ] ensure:[

        ftp notNil ifTrue:[

            ftp close.

        ].

    ]

!

pathExists

    "establish a connection for try to get a readSteream"

    |exists|

    self connectThenDo:[:aFtpClient|

        exists := self pathExistsFtp:aFtpClient.

    ].

    ^ exists ? false

"

    |pwd uri|

    pwd := Dialog requestPassword:'Password:'. 

    uri := (URI fromString:('ftp://tm:%1@exept/home/tm/tmp/test.txt' bindWith:pwd) ).

    uri pathExists

"

!

pathExists:aPathname ftpClient:aFtpClient

    |list|

    list := aFtpClient list:aPathname.

    ^ list contains:[:aLine| (aLine asCollectionOfWords last) = aPathname ] 

!

pathExistsFtp:aFtpClient

    ^ self pathExists:self path ftpClient:aFtpClient

! !

!FtpURI methodsFor:'stream access'!

readStreamDo:aBlock

    "use FTPClient for now"

    self connectThenDo:[:ftp| |stream path attributes|

        [

            path := self path.

            attributes := self class attributes.

            attributes at:#fileSize put:(ftp sizeOf:path).

            attributes at:#baseName put:self pathSegements last.  

            attributes at:#uriInfo  put:self printString.  

            stream := ftp getStreamFor:path.

            aBlock value:stream value:attributes.

        ] ensure:[

            stream notNil ifTrue:[

                stream close.

            ].

        ].

    ].

    "

         self halt

      ].

    "

!

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

     The streams are closed after aBlock has been evaluated.

     Attributes may be the mime type (key #MIME)"

    self readStreamsDo:aBlock skipFilenamesWithSuffix:nil thenRemove:false

!

readStreamsDo:aBlock skipFilenamesWithSuffix:aSuffix 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

     The streams are closed after aBlock has been evaluated.

     Attributes may be the mime type (key #MIME)"

    |attributes list requestDirectory path dirPath|

    requestDirectory := false.

    path := self path.

    attributes := self class attributes.

    list := OrderedCollection new.

    self connectThenDo:[:ftp|

        FTPClient fileErrorSignal handle:[:ex|

            list add:path.

            attributes at:#requestDirectory put:false.

        ] do:[

            dirPath := path.

            ftp cd:dirPath.

            requestDirectory := true.

            attributes at:#requestDirectory put:true.

            list addAll:((ftp list) collect:[:aLine| aLine asCollectionOfWords last]).

        ].

        requestDirectory ifFalse:[ |bName|

            bName := self pathSegements last.

            (bName startsWith:'*') ifTrue:[

                list removeAll.

                requestDirectory := true.

                attributes at:#requestDirectory put:true.

                dirPath := (path asFilename directory) pathName.

                ftp cd:dirPath.

                list addAll:((ftp list) collect:[:aLine| aLine asCollectionOfWords last]).

            ].

            (bName startsWith:'*.') ifTrue:[ |rest|

                rest := bName restAfter:$*.

                (rest includesString:'*') ifTrue:[

                    self error:'can''t resolve path:', self printString

                ].

                list := list select:[:str| str endsWith:rest ]

            ].

        ].

        aSuffix size ~~ 0 ifTrue:[

            list := list select:[:str| (str endsWith:aSuffix) not ]

        ].

        list do:[:aPathName| |baseName stream|

            FTPClient fileErrorSignal handle:[:ex| 

                "/ skip subdirectories and the summary of the list

            ] do:[

                stream := ftp getStreamFor:aPathName.

                attributes at:#fileSize put:(ftp sizeOf:aPathName).

                requestDirectory 

                    ifTrue:[  baseName := aPathName ] 

                    ifFalse:[ baseName := self pathSegements last ].

                attributes at:#baseName put:baseName

            ].

            stream notNil ifTrue:[ |src srcPath|

                (self pathSegements includes:baseName) ifTrue:[ 

                    srcPath := (dirPath asFilename) pathName.

                    attributes at:#uriInfo put:self.  

                ] ifFalse:[ |pathSegements|

                    src := self copy.

                    pathSegements := (dirPath asFilename construct:baseName) components.

                    pathSegements removeFirst.

                    src pathSegements:pathSegements.

                    srcPath := src path.

                    attributes at:#uriInfo put:src.  

                ].

                [ aBlock value:stream value:attributes ] 

                    ensure:[ stream close ].

                doRemoveSource == true ifTrue:[ 

                    (srcPath startsWith:'/') ifFalse:[ srcPath := '/', srcPath ].

                    ftp delete:srcPath.

                ].

            ].

        ].

    ].

    "

        |pwd|

        pwd := Dialog requestPassword:''. 

        (URI fromString:('ftp://tm:%1@exept/home/tm/tmp' bindWith:pwd) ) 

            readStreamsDo:[:stream :attributes | 

                Transcript showCR:(attributes at:#baseName).

                Transcript showCR:(attributes at:#fileSize).

                Transcript showCR:(attributes at:#requestDirectory).

                Transcript showCR:(attributes at:#uriInfo).

            ].

    "

!

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

     The streams are closed after aBlock has been evaluated.

     Attributes may be the mime type (key #MIME)"

    self readStreamsDo:aBlock skipFilenamesWithSuffix:nil thenRemove:doRemoveSource

!

writeStreamDo:aBlock

    "use FTPClient for now"

    self connectThenDo:[:ftp| |stream|

        [

            ftp connectTo:self host 

                port:self port 

                user:(self user ? self defaultUser)

                password:(self password ? self defaultPassword).

            stream := ftp putStreamFor:self path.

            aBlock value:stream value:self class attributes.

        ] ensure:[

            stream notNil ifTrue:[

                stream close.

            ].

        ].

    ]

    "

         self halt

      ].

    "

!

writeStreamDo:aBlock create:doCreate

    path := self path.

    self connectThenDo:[:ftp| |stream|

        [

            ftp connectTo:self host 

                port:self port 

                user:(self user ? self defaultUser)

                password:(self password ? self defaultPassword).

                doCreate ifFalse:[

                    ex reject

                FTPClient fileNotFoundErrorSignal handle:[:ex| ] do:[

                ].

            ].

            aBlock value:stream value:self class attributes.

        ] ensure:[

            stream notNil ifTrue:[

                stream close.

            ].

        ].

    ]

! !

!FtpURI class methodsFor:'documentation'!

version

! !