"======================================================================
|
|   URL class
|
|   $Revision: 1.7.5$
|   $Date: 2000/05/28 16:56:52$
|   $Author: pb$
|
 ======================================================================"


"======================================================================
|
| Copyright 1988-92, 1994-95, 1999, 2000 Free Software Foundation, Inc.
| Written by Paolo Bonzini.
|
| This file is part of the GNU Smalltalk class library.
|
| The GNU Smalltalk class library is free software; you can redistribute it
| and/or modify it under the terms of the GNU Lesser General Public License
| as published by the Free Software Foundation; either version 2.1, or (at
| your option) any later version.
| 
| The GNU Smalltalk class library is distributed in the hope that it will be
| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
| General Public License for more details.
| 
| You should have received a copy of the GNU Lesser General Public License
| along with the GNU Smalltalk class library; see the file COPYING.LESSER.
| If not, write to the Free Software Foundation, 59 Temple Place - Suite
| 330, Boston, MA 02111-1307, USA.  
|
 ======================================================================"


Object subclass: #URL
       instanceVariableNames: 'protocol host port file anchor cachedHash'
       classVariableNames: 'ProtocolClasses NoPercentEncoding DefaultProtocol DefaultFile'
       poolDictionaries: ''
       category: 'Sockets-RFC'
!

!URL class methodsFor: 'encoding URLs'!

decode: anURL
    | result in ch |
    result := WriteStream on: (String new: anURL size).
    in := ReadStream on: anURL.
    [ in atEnd ] whileFalse: [
	(ch := in next) = $+
	    ifTrue: [ result nextPut: $  ]
	    ifFalse: [
		 ch = $%
		    ifFalse: [ result nextPut: ch ]
		    ifTrue: [
			ch := in next digitValue * 16 + in next digitValue.
			result nextPut: ch asCharacter
		    ]
	    ]
    ].
    ^result contents
!

encode: anURL
    | result value |
    result := WriteStream on: (String new: anURL size + 10).
    anURL do: [ :each |
	(each = $ )
	    ifTrue: [ result nextPut: $+ ]
	    ifFalse: [
		value := each value.
		(NoPercentEncoding at: value) = 1
		    ifTrue: [ result nextPut: each ]
		    ifFalse: [
			result
			    nextPut: $%;
			    nextPut: ('0123456789ABCDEF' at: value // 16 + 1);
			    nextPut: ('0123456789ABCDEF' at: value \\ 16 + 1)
		    ]
	    ]
    ].
    ^result contents
!

initialize
    ProtocolClasses := Dictionary new.
    DefaultProtocol := 'http:'.
    DefaultFile := 'index.htm'.

    NoPercentEncoding := ByteArray new: 256.
    'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ -_.*0123456789'
	do: [ :each |
	    NoPercentEncoding at: each value put: 1
	]
! !

!URL class methodsFor: 'accessing'!

defaultFile
    ^DefaultFile
!

defaultFile: file
    DefaultFile := file
!

defaultProtocol
    ^DefaultProtocol
!

defaultProtocol: protocol
    DefaultProtocol := protocol
!

use: aProtocolClass forProtocol: aString
    ^ProtocolClasses at: aString put: aProtocolClass
! !

!URL class methodsFor: 'private'!

file: file relativeTo: url into: new
    | spec host port first i j |

    spec := file.
    first := spec findFirst: [ :each | each ~= $  ].
    (first + 3 <= spec size)
	ifTrue: [
	    (spec copyFrom: first to: first + 3) = 'url:'
		ifTrue: [ first := first + 4 ]
	].

    "Remove leading and trailing white space"
    spec := spec
	copyFrom: first
	to: (spec findLast: [ :each | each ~= $  ]).

    (spec at: 1) = $# ifTrue: [
	 url isNil ifFalse: [ self error: 'missing file in absolute URL' ].
	 new anchor: (spec copyFrom: 2 to: spec size).
	 new computeHash.
	 ^new
    ].

    "Search for :/ - if present, the protocol is from the start to :"
    i := spec indexOf: $/.
    i > 1 ifTrue: [
	(spec at: i - 1) = $:
	    ifTrue: [ new protocol: (spec copyFrom: 1 to: i - 1) ].

	"If the protocol changed, the URL must be absolute"
	new protocol = url protocol ifFalse: [
	    new host: nil; port: -1; file: nil; anchor: nil
	]
    ].
    new protocol isNil ifTrue: [ new protocol: self defaultProtocol ].

    "If <protocol>//<xxx>, <xxx> is the host and, maybe, the port.
	i is here-^						"

    ((i < spec size) and: [ (spec at: i + 1) = $/ ]) ifTrue: [
	j := spec indexOf: $/ startingAt: i + 2 ifAbsent: [ spec size + 1 ].
	host := spec copyFrom: i + 2 to: j - 1.
	i := j.

	new port: -1.
	j := host indexOf: $:.
	j = 0
	    ifFalse: [
		port := host copyFrom: j + 1 to: host size.
		host := host copyFrom: 1 to: j - 1.
		port isEmpty ifFalse: [
		    (port allSatisfy: [ :each | each isDigit ])
			ifFalse: [ self error: 'non-numeric character in port' ]
			ifTrue: [ new port: port asInteger ]
		]
	    ].

	host isEmpty ifTrue: [ self error: 'empty host name' ]
	new host: host.
    ].

    i >= spec size ifTrue: [
	^new file: self defaultFile; anchor: nil; computeHash; yourself
    ].

    j := spec indexOf: $# startingAt: i + 1 ifAbsent: [ spec size + 1 ].
    new file: (spec copyFrom: i + 1 to: j - 1).

    j < spec size
	ifTrue: [ new anchor: (spec copyFrom: j + 1 to: spec size) ]
	ifFalse: [ new anchor: nil ].

    ^new computeHash; yourself
! !

!URL class methodsFor: 'instance creation'!

file: spec relativeTo: url
    ^self file: spec relativeTo: url into: url copy
!

fromString: aString
    ^self file: aString relativeTo: nil into: URL basicNew
!

new
    self shouldNotImplement
!

protocol: protocol host: host file: file
    ^self protocol: protocol host: host port: -1 file: file
!

protocol: protocol host: host port: port file: file
    | anchor pos |
    pos := file indexOf: $# ifAbsent: [ file size + 1 ]
    pos < file size
	ifTrue: [ anchor := file copyFrom: pos + 1 to: file size ].

    ^URL basicNew
	protocol: protocol;
	host: host;
	port: port;
	file: (file copyFrom: 1 to: pos - 1);
	anchor: anchor;
	computeHash;
	yourself
! !

!URL methodsFor: 'accessing'!

= anURL
    self hash = anURL hash ifFalse: [ ^false ].
    self class == anURL class ifFalse: [ ^false ].

    ^(self protocol sameAs: anURL protocol) and: [
     (self host sameAs: anURL host) and: [
     self port = anURL port and: [
     (URL decode: self file) = (URL decode: anURL file) and: [
     (URL decode: self anchor) = (URL decode: anURL anchor) ]]]]
!

anchor
    ^anchor
!

contents
    ^self newConnection contents
!

decodedAnchor
    ^URL decode: self anchor
!

decodedFile
    ^URL decode: self file
!

decodeFields: aString
    "Convert the form fields in aString to a query dictionary, answer
     nil if no question mark is found in the URL's `file' component."

    | query dict |

    query := self query.
    query isNil ifTrue: [ ^nil ].

    dict := Dictionary new.
    (query substrings: $&) do: [ :keyValue || i key value |
	i := keyValue indexOf: $= ifAbsent: [ value := nil. keyValue size + 1 ].
	key := keyValue copyFrom: 1 to: i - 1.
	i < keyValue size ifTrue: [
	    value := keyValue copyFrom: i + 1 to: value size.
	    value := URL decode: value
	].
	self add: key to: dict value: value
    ].
    ^dict
!

file
    ^file
!

hash
    ^cachedHash
!

host
    ^host
!

newConnection
    ^(ProtocolClasses at: self protocol) on: self
!

port
    ^port = -1
	ifTrue: [ Socket defaultPortAt: self protocol ifAbsent: [ -1 ] ]
	ifFalse: [ port ]
!

protocol
    ^protocol
!

query
    "Answer the receiver's ``query'' part, containing the value of
     form fields (i.e. everything in the file part that follows a
     question mark), or nil if there is none."
    ^self file
	copyFrom: (self file indexOf: $? ifAbsent: [ ^nil ])
	to: self file size
!

relative: urlSpec
    ^self species file: urlSpec relativeTo: self
!

sameFileAs: anURL
    ^self = anURL or: [ self anchor ~= anURL anchor ]
!

sameHostAs: anURL
    ^self host = anURL host or: [
	(IPAddress byName: self host) = (IPAddress byName: anURL host) ]
! !

!URL methodsFor: 'printing'!

printOn: aStream

    aStream
	nextPutAll: self protocol asLowercase;
	nextPut: $/;
	nextPut: $/;
	nextPutAll: self host asLowercase.

    port > 0 ifTrue: [
	aStream
	    nextPut: $: ;
	    print: self port
    ].
    aStream
	nextPut: $/ ;
	nextPutAll: (URL encode: (URL decode: self file)).

    anchor isNil ifFalse: [
	aStream
	    nextPut: $# ;
	    nextPutAll: (URL encode: (URL decode: self anchor))
    ].
! !

!URL methodsFor: 'private'!

add: key to: dict value: value
    "Add the key->value pair to dict; if the key is specified multiple times,
     make an OrderedCollection with all the values"

    | values |
    values := dict at: key ifAbsent: [ ^dict at: key put: value ].
    values isString ifFalse: [ ^values add: value ].

    "Make the OrderedCollection"
    dict at: key put: (OrderedCollection with: values with: value).
    ^value
!

computeHash
    ^cachedHash := self printString hash
!

protocol: newProtocol
    protocol := newProtocol asLowercase
!

host: newHost
    host := newHost asLowercase
!

file: newFile
    file := newFile
!

port: newPort
    port := newPort asLowercase
!

anchor: newAnchor
    anchor := newAnchor
! !
