"{ Package: 'stx:libbasic2' }"

URI subclass:#HierarchicalURI
	instanceVariableNames:'authority isAbsolute isDirectory pathSegments query fragment'
	classVariableNames:''
	poolDictionaries:''
	category:'Resources'
!

!HierarchicalURI class methodsFor:'documentation'!

documentation
"
    Hierarchical URI as defined in RFC2396:

    <scheme:[//authority][/absolute_path][?query][#fragment]>

    [author:]
        Stefan Vogel (stefan@zwerg)

    [see also:]

    [instance variables:]

    [class variables:]
"
!

examples
"

  more examples to be added:
                                                                [exBegin]
    |u1 u2|

    u1 := URI fromString:'file:/phys/exept/tmp/'.
    u2 := u1 construct:'test.txt'.
    Transcript showCR:u1.
    Transcript showCR:u2.
                                                                [exEnd]

                                                                [exBegin]
    |u1 u2|

    u1 := URI fromString:'file:/phys/exept/tmp'.
    u2 := u1 construct:'test.txt'.
    Transcript showCR:u1.
    Transcript showCR:u2.
                                                                [exEnd]
"
! !

!HierarchicalURI class methodsFor:'instance creation'!

new

    ^ self basicNew initialize
!

scheme:aSchemeString fromString:aString
    "parse the hierarchical information.
     schemeString is ignored here"

    ^ self new scheme:aSchemeString; 
               fromString:aString
! !

!HierarchicalURI methodsFor:'accessing'!

authority
    "return the value of the instance variable 'authority' (automatically generated)"

    ^ authority
!

authority:something
    "set the value of the instance variable 'authority' (automatically generated)"

    authority := something.
!

baseName
    ^ pathSegments last
!

examples
"

  more examples to be added:
                                                                [exBegin]
        URI fromString:'file:/phys/exept/home/tm/tmp'
                                                                [exEnd]
"
!

fragment
    "return the value of the instance variable 'fragment' (automatically generated)"

    ^ fragment
!

fragment:something
    "set the value of the instance variable 'fragment' (automatically generated)"

    fragment := something.
!

isAbsolute
    "return the value of the instance variable 'isAbsolute' (automatically generated)"

    ^ isAbsolute
!

isDirectory
    "return the value of the instance variable 'isDirectory' (automatically generated)"

    ^ isDirectory ? false
!

pathSegments
    "return the value of the instance variable 'pathSegments' (automatically generated)"

    ^ pathSegments
!

pathSegments:something
    "set the value of the instance variable 'pathSegments' (automatically generated)"

    pathSegments := something.
!

query
    "return the value of the instance variable 'query' (automatically generated)"

    ^ query
!

query:something
    "set the value of the instance variable 'query' (automatically generated)"

    query := something.
! !

!HierarchicalURI methodsFor:'accessing-details'!

host
    "answer the host part of authority"

    |start end|

    authority isNil ifTrue:[
        ^ nil
    ].
    start := (authority indexOf:$@) + 1.
    end := (authority indexOf:$: startingAt:start) - 1.
    end == -1 ifTrue:[
        end := authority size
    ].
    ^ authority copyFrom:start to:end

    "
      (self fromString:'ftp://stefan@www.exept.de:80/test') host
      (self fromString:'ftp://www.exept.de:80/test') host
      (self fromString:'ftp://www.exept.de/test') host
    "
!

password
    "answer the user part of authority"

    |end start|

    authority isNil ifTrue:[
        ^ nil
    ].
    end := authority indexOf:$@.
    end == 0 ifTrue:[
        ^ nil
    ].
    start := authority indexOf:$:.
    (start == 0 or:[start > end]) ifTrue:[
        ^ nil
    ].
    ^ authority copyFrom:start+1 to:end-1

    "
      (self fromString:'ftp://stefan@www.exept.de:80/test') password
      (self fromString:'ftp://stefan:pass@www.exept.de:80/test') password
      (self fromString:'ftp://www.exept.de:80/test') password
    "
!

port
    "answer the port part of authority"

    |start|

    authority isNil ifTrue:[
        ^ self defaultPort
    ].
    start := authority indexOf:$@.
    start := authority indexOf:$: startingAt:start.
    start == 0 ifTrue:[
        ^ self defaultPort
    ].

    ^ authority copyFrom:start+1

    "
      (self fromString:'ftp://stefan@www.exept.de:80/test') port
      (self fromString:'ftp://www.exept.de:80/test') port
      (self fromString:'ftp://www.exept.de/test') port
    "
!

user
    "answer the user part of authority"

    |end end1|

    authority isNil ifTrue:[
        ^ nil
    ].
    end := authority indexOf:$@.
    end == 0 ifTrue:[
        ^ nil
    ].
    end1 := authority indexOf:$:.
    end1 ~~ 0 ifTrue:[
        end := end min:end1.
    ].
    ^ authority copyTo:end-1

    "
      (self fromString:'ftp://stefan@www.exept.de:80/test') user
      (self fromString:'ftp://stefan:pass@www.exept.de:80/test') user
      (self fromString:'ftp://www.exept.de:80/test') user
    "
! !

!HierarchicalURI methodsFor:'copying'!

postCopy

    pathSegments := pathSegments copy
! !

!HierarchicalURI methodsFor:'defaults'!

defaultPort
   "answer the default port for the given scheme.
    Concrete subclasses redefine this method"

   ^ nil
! !

!HierarchicalURI methodsFor:'escape'!

unEscape
    "convert escaped characters (such as %20 for ' ') to their native
     representation"

    authority := self class unEscape:authority readStream.
    pathSegments keysAndValuesDo:[:i :v|
        pathSegments at:i put:(self class unEscape:v readStream).
    ].
    query := self class unEscape:query readStream.
    fragment := self class unEscape:fragment readStream.
! !

!HierarchicalURI methodsFor:'initialize'!

fromString:aString

    |i i1 separator|

    (aString startsWith:'//') ifTrue:[
        i := aString indexOfAny:'/?#' startingAt:3.
        i == 0 ifTrue:[
            authority := aString copyFrom:3.
            ^ self.
        ] ifFalse:[
            separator := aString at:i.
            authority := aString copyFrom:3 to:i-1.
        ].
        (isAbsolute := (aString at:i) == $/).
    ] ifFalse:[
        (isAbsolute := aString startsWith:$/) ifTrue:[
            i := 1.
        ] ifFalse:[
            i := 0.
        ]
    ].

    [
        i1 := aString indexOfAny:'/?#' startingAt:i+1.
        i1 == 0 ifTrue:[ |path|
            path := aString copyFrom:i+1.
            path size ~~ 0 ifTrue:[
                pathSegments add:path.
            ] ifFalse:[
                (aString at:i) == $/ ifTrue:[
                    isDirectory := true
                ].
            ].
            ^ self.
        ] ifFalse:[
            separator := aString at:i1.
            pathSegments add:(aString copyFrom:i+1 to:i1-1).
            isAbsolute ifTrue:[
                pathSegments size == 1 ifTrue:[
                    (pathSegments first startsWith:$~) ifTrue:[
                        isAbsolute := false
                    ].
                ].
            ].
            i := i1.
        ].
    ] doWhile:[separator == $/].

    separator == $? ifTrue:[
        i1 := aString indexOf:$# startingAt:i+1.
        i1 == 0 ifTrue:[
            query := aString copyFrom:i+1.
            ^ self.
        ] ifFalse:[
            separator := aString at:i1.
            query := aString copyFrom:i+1 to:i1-1.
            i := i1.
        ].
    ].
    separator == $# ifTrue:[
        fragment := aString copyFrom:i+1.
    ].
        
    "
     self new fromString:'//exept~/tmp'  
     self new fromString:'~/tmp'        
     self new fromString:'/~/tmp'       
     self new fromString:'//authority/path1/path2/' 
     self new fromString:'//authority/path1/path2?query'
     self new fromString:'//authority/path1/path2?query#fragment'
     self new fromString:'/path1/path2?query#fragment'
     self new fromString:'/path1/path2#fragment'
     self new fromString:'path1/path2#fragment'
    "    
!

initialize

    pathSegments := OrderedCollection new.
! !

!HierarchicalURI methodsFor:'printing & storing'!

directoryPath
    "answer the directory path part of the URI"

    |aStream|

    aStream := WriteStream on:''.

    pathSegments size ~~ 0 ifTrue: [
        self isAbsolute ifTrue:[
            aStream nextPut:$/.
        ].
        pathSegments size > 1 ifTrue:[
            (pathSegments copyTo:pathSegments size-1) do:[:p|
                self class escape:p allow:'~;:@&=+",' on:aStream
            ] separatedBy:[
                aStream nextPut:$/
            ].
        ].
    ].

    ^ aStream contents
!

path
    "answer the path part of the URI"

    |aStream|

    aStream := WriteStream on:''.

    pathSegments size ~~ 0 ifTrue: [
        self isAbsolute ifTrue:[
            aStream nextPut:$/.
        ].
        pathSegments do:[:p|
            self class escape:p allow:'~;:@&=+",' on:aStream
        ] separatedBy:[
            aStream nextPut:$/
        ].
    ].
    query notNil ifTrue: [
        aStream nextPut:$?.
        self class escape:query allow:nil on:aStream
    ].
    fragment notNil ifTrue: [
        aStream nextPut:$#.
        self class escape:fragment allow:nil on:aStream
    ].

    ^ aStream contents
!

printOn:aStream

    self printOn:aStream escape:false
!

printOn:aStream escape:doEscape
    "print the URI on aStream. If doEscape is set, escape special
     characters"

    super printOn:aStream.
    authority notNil ifTrue: [
        aStream nextPutAll:'//'.
        doEscape ifTrue:[
            self class escape:authority allow:'~$,;:@&=+' on:aStream
        ] ifFalse:[
            aStream nextPutAll:authority
        ]
    ].

    self printPathOn:aStream escape:doEscape.
!

printPathOn:aStream escape:doEscape
    "print the path part"
    
    pathSegments size ~~ 0 ifTrue: [
        self isAbsolute ifTrue:[
            aStream nextPut:$/.
        ].
        pathSegments do:[:p|
            doEscape ifTrue:[
                self class escape:p allow:'~;:@&=+",' on:aStream
            ] ifFalse:[
                aStream nextPutAll:p
            ]
        ] separatedBy:[
            aStream nextPut:$/
        ].
    ].
    query notNil ifTrue: [
        aStream nextPut:$?.
        doEscape ifTrue:[
            self class escape:query allow:nil on:aStream
        ] ifFalse:[
            aStream nextPutAll:query
        ]

    ].
    fragment notNil ifTrue: [
        aStream nextPut:$#.
        doEscape ifTrue:[
            self class escape:fragment allow:nil on:aStream
        ] ifFalse:[
            aStream nextPutAll:fragment
        ]
    ].
!

publicPrintOn:aStream
    "print, but omit password information"

    |password|

    password := self password.
    password size ~~ 0 ifTrue:[
        super printOn:aStream.
        aStream 
                nextPutAll:'//';
                nextPutAll:self user;
                nextPut:$@;
                nextPutAll:self host.
        self printPathOn:aStream escape:true.
    ] ifFalse:[
        "no password, use normal printing"
        self printOn:aStream
    ].
! !

!HierarchicalURI methodsFor:'resolution'!

addComponent:aString
    "concatenate aString to my path"

    (aString = '..' 
     and:[pathSegments size ~~ 0 
     and:[pathSegments last ~= '..']]) ifTrue:[
        pathSegments removeLast.
    ] ifFalse:[
        pathSegments add:aString
    ].
!

construct:aString
    "concatenate aString to my path"

    ^ self copy 
        addComponent:aString;
        yourself.
!

directory
    "remove the last path component"

    ^ self copy 
        removeLastComponent;
        yourself.
!

removeLastComponent
    "remove the last component"

    pathSegments size ~~ 0 ifTrue:[ 
        pathSegments last = '..' ifTrue:[
            pathSegments add:'..'.
        ] ifFalse:[
            pathSegments removeLast.
        ].
    ].
! !

!HierarchicalURI class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic2/HierarchicalURI.st,v 1.8 2003-07-14 14:28:35 stefan Exp $'
! !