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

"

!

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

! !

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

pathExists

    "returns true if path 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

! !