"{ 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 URI'

    ].

    scheme := aString copyFrom:1 to:i-1.

    rest := aString copyFrom:i+1.

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

! !

!URI class methodsFor:'accessing'!

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]

!

schemes

    "answer the schemes supported by an URI-class.

     Concrete subclasses redefine this to answer an array of scheme names"

    ^ nil

! !

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

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

! !

!URI class methodsFor:'documentation'!

version

    ^ '$Header: /cvs/stx/stx/libbasic2/URI.st,v 1.1 2002-01-17 14:25:48 stefan Exp $'

! !