"{ Package: 'stx:libbasic2' }"

Object subclass:#URI
	instanceVariableNames:'scheme'
	classVariableNames:''
	poolDictionaries:''
	category:'Resources'
!


!URI class methodsFor:'instance creation'!

fromString:aString
    "create an URI from a given String"

    |i scheme rest|

    i := aString indexOf:$:.
    i == 0 ifTrue:[ 
        self error:('Missing scheme in: %1!!' bindWith:aString)
    ].
    scheme := aString copyFrom:1 to:i-1.
    rest := aString copyFrom:i+1.

    ^ (self classForScheme:scheme) scheme:scheme fromString:rest



"
    self fromString:''
    self fromString:'file:~'
    self fromString:'ftp://exept.exept.de/~stefan/bla'
"
!

fromString:aString onError:exceptionBlock
    "create an URI from a given String"

    |uri|

    Error handle:[:ex| 
        exceptionBlock value.
    ] do:[
        uri := self fromString:aString
    ].

    ^ uri

"
    self fromString:'' onError:nil    
"
! !

!URI class methodsFor:'accessing'!

attributes

    |dict|

    dict := Dictionary new.
    dict at:#MIME put:'text/plain'.
    ^ dict
!

classForScheme:aString
    "find a class for a given scheme name aString"

    |s|

    s := aString asLowercase.

    ^ self allSubclasses detect:[:cls| |schemes|
        schemes := cls schemes.
        schemes size ~~ 0 and:[schemes includes:s]
    ] ifNone:[HierarchicalURI]

"
    self classForScheme:'file'
"
!

schemes
    "answer the schemes supported by an URI-class.
     Concrete subclasses redefine this to answer an array of scheme names"

    ^ nil
!

transferBufferSize
    ^ 8 * 1024
! !

!URI class methodsFor:'escape'!

escape:aString allow:additionalCharacters on:aStream

    |val|

    aString do:[:c|
        ((c isLetterOrDigit) 
         or:[('-_.!!~*''()' includes:c) 
         or:[additionalCharacters notNil 
             and:[additionalCharacters includes:c]]]
        ) ifTrue:[
            aStream nextPut:c
        ] ifFalse:[
            val := c asciiValue.            
            aStream nextPut:$%; 
                    nextPut:(Character digitValue:val//16);
                    nextPut:(Character digitValue:val\\16).
        ].
    ].
        

    "
     self escape:'0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ'
          allow:nil on:TextCollector open

     self escape:'Ein text mit blanks und @ & #' 
          allow:nil on:TextCollector open
    "  
!

unEscape:aStream
    "convert escape sequences to the original characters"

    |s c1 c2|

    s := WriteStream on:''.

    [aStream atEnd] whileFalse:[
        c1 := aStream next.
        c1 == $% ifTrue:[
            c1 := aStream next.
            c1 isNil ifTrue:[
                self error:'escape sequence incomplete'
            ].
            c2 := aStream next.
            c2 isNil ifTrue:[
                self error:'escape sequence incomplete'
            ].
            c1 := c1 digitValue.
            c2 := c2 digitValue.
            (c1 > 15 or:[c2 > 15]) ifTrue:[
                self error:'escape sequence: expect hex digit'
            ].
            c1 := Character value:c1*16 + c2.
        ].
        s nextPut:c1.
    ].

    ^ s contents.

    "
     self unEscape:(self escape:'   &%@   ' allow:nil) readStream
    "
! !

!URI methodsFor:'accessing'!

scheme
    "return primary scheme of the class.
     Concrete subclasses may redefine this"

    |schemes|

    schemes := self class schemes.
    ^ schemes size ~~ 0 ifTrue:[
        schemes at:1
    ] ifFalse:[
        nil
    ]
!

scheme:aString
    "set the scheme. This is a noop here and may be 
     defined by subclasses"

    ^ self
! !

!URI methodsFor:'comparing'!

= anURI
    ^ self class == anURI class and:[self asString == anURI asString]
!

hash
    ^ self asString hash
! !

!URI methodsFor:'converting'!

asURI

    ^ self
! !

!URI methodsFor:'printing & storing'!

printOn:aStream

    |scheme|

    scheme := self scheme.
    scheme size ~~ 0 ifTrue:[
        aStream nextPutAll:scheme; nextPut:$:
    ].
! !

!URI methodsFor:'subclass responsibility'!

exists
    "return true if the resource represented by this uri exists"

    ^ self subclassResponsibility
!

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 may be the mime type (key #MIME)"

    ^ self subclassResponsibility
!

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

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

    ^ self subclassResponsibility
! !

!URI class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic2/URI.st,v 1.7 2003-07-13 22:40:50 stefan Exp $'
! !