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

    "
     'ftp://stefan:mschrat.14@hippo/etc/group' asURI readStreamDo:[:stream :attributes | 
         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|

    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:[
            ftp cd:path.
            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.
                ftp cd:(path asFilename directory) pathName.
                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 ensWith: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 := self path.
                    attributes at:#uriInfo put:self.  
                ] ifFalse:[
                    src := ((self copy) addComponent:baseName).
                    srcPath := src path.
                    attributes at:#uriInfo put:src.  
                ].

                [ aBlock value:stream value:attributes ] 
                    ensure:[ stream close ].
                doRemoveSource == true ifTrue:[ 
                    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.
            ].
        ].
    ]

    "
     'ftp://stefan:mschrat.14@hippo/etc/group' asURI readStreamDo:[:stream :attributes | 
         self halt
      ].
    "
! !

!FtpURI class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic2/FtpURI.st,v 1.4 2003-07-10 09:42:47 tm Exp $'
! !