"

 COPYRIGHT (c) 2007 by eXept Software AG

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libbasic2' }"

Object subclass:#HTMLUtilities

	instanceVariableNames:''

	classVariableNames:'EscapeControlCharacters'

	poolDictionaries:''

	category:'Net-Communication-Support'

!

!HTMLUtilities class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 2007 by eXept Software AG

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    Collected support functions to deal with HTML.

    Used both by HTML generators (DocGenerator), HTMLParsers and the webServer.

    Therefore, it has been put into libbasic2.

"

! !

!HTMLUtilities class methodsFor:'helpers'!

controlCharacters

    EscapeControlCharacters isNil ifTrue:[

        EscapeControlCharacters := Dictionary new.

"/        EscapeControlCharacters at:Character space put:' '.

        EscapeControlCharacters at:$< put:'&lt;'.

        EscapeControlCharacters at:$> put:'>'.

        EscapeControlCharacters at:$& put:'&'.

        EscapeControlCharacters at:$" put:'"'.

    ].

    ^ EscapeControlCharacters.

!

escapeCharacterEntities:aString

    "helper to escape invalid/dangerous characters in html strings.

     These are:

        control characters, '<', '>', '&' and space -> %XX ascii as hex digits

        %     -> %%

    "

    |rs ws c controlCharacters controlString|

    controlCharacters := self controlCharacters.

    rs := ReadStream on: aString.

    ws := WriteStream on: ''.

    [ rs atEnd ] whileFalse: [

        c := rs next.

        controlString := controlCharacters at:c ifAbsent:nil.

        controlString notNil ifTrue:[

            ws nextPutAll:controlString.

        ] ifFalse:[

            c codePoint > 16r7F ifTrue:[

                ws 

                    nextPutAll:'&#';

                    nextPutAll:(c codePoint printString);

                    nextPutAll:';'.

            ] ifFalse:[

                ws nextPut:c.

            ]

        ]

    ].

    ^ ws contents

    "

     self escapeCharacterEntities:'a<b'     

     self escapeCharacterEntities:'aöb'     

    "

!

extractCharSetEncodingFromContentType:contentTypeLine

    |idx rest encoding|

    idx := contentTypeLine findString:'charset='.

    idx == 0 ifTrue:[

	^ nil

    ].

    rest := (contentTypeLine copyFrom:idx+'charset=' size) withoutSeparators.

    idx := (rest indexOfSeparator) min:(rest indexOf:$;).

    idx == 0 ifTrue:[

	encoding := rest

    ] ifFalse:[

	encoding := rest copyTo:idx-1.

    ].

    (encoding startsWith:$") ifTrue:[

	encoding := encoding copyFrom:2 to:(encoding indexOf:$" startingAt:3)-1.

    ].

    ^ encoding.

    "

     self extractCharSetEncodingFromContentType:'text/html; charset=ascii'

     self extractCharSetEncodingFromContentType:'text/html; charset='

     self extractCharSetEncodingFromContentType:'text/html; fooBar=bla'

     self extractCharSetEncodingFromContentType:'text/xml; charset=utf-8'

     self extractCharSetEncodingFromContentType:'text/xml; charset=utf-8; bla=fasel'

    "

!

extractMimeTypeFromContentType:contentTypeLine

    |idx mimeAndEncoding|

    idx := contentTypeLine indexOf:$:.

    mimeAndEncoding := (contentTypeLine copyFrom:idx+1) withoutSeparators.

    (mimeAndEncoding includes:$;) ifFalse:[

	^ mimeAndEncoding

    ].

    idx := mimeAndEncoding indexOf:$;.

    ^ mimeAndEncoding copyTo:idx-1

    "

     self extractMimeTypeFromContentType:'text/html; charset=ascii'

     self extractMimeTypeFromContentType:'text/html; '

     self extractMimeTypeFromContentType:'text/html'

     self extractMimeTypeFromContentType:'text/xml; charset=utf-8'

    "

!

unEscape:aString

    "Convert escaped characters in an urls arguments or post fields to their proper characters.

     These are:

        + -> space

        %XX ascii as hex digits

        %% -> %

    "

    |rs ws c peekC|

    (aString indexOfAny:'+%') == 0 ifTrue:[

        ^ aString

    ].

    rs := ReadStream on: aString.

    ws := WriteStream on: ''.

    [rs atEnd] whileFalse:[

        c := rs next.

        c == $+ 

            ifTrue:[ c := Character space ] 

            ifFalse:[

                c == $% 

                    ifTrue: [

                        peekC := rs peek.

                        (peekC notNil and:[peekC isHexDigit]) ifTrue:[

                            c := (Integer readFrom:(rs next:2) radix:16) asCharacter 

                        ] ifFalse:[

                            c := rs next.

                        ]

                    ]

            ].

        ws nextPut: c.

    ].

    ^ ws contents

    "

     self new unEscape:'a%20b' 

     self new unEscape:'a%%b'

     self new unEscape:'a+b' 

     self new unEscape:'a%+b' 

    "

!

urlEncoded: aString

    "helper to escape invalid/dangerous characters in an urls arguments or post-fields.

        see: application/x-www-form-urlencoded

    "

"

self unEscape:(self urlEncoded:'_-.*Frankfurt(Main) Hbf')

self urlEncoded:'_-.*Frankfurt(Main) Hbf') unescape

self unEscape:(self urlEncoded:'-_.*%exept;')

self urlEncoded:'-_.*%exept;'

"

    | rs ws c space|

    space := Character space.

    rs := ReadStream on: aString.

    ws := WriteStream on: ''.

    [ rs atEnd ] whileFalse: [

        c := rs next.

        c isLetterOrDigit ifTrue:[

            ws nextPut:c.

        ] ifFalse:[

            c == space ifTrue:[

                ws nextPut:$+.

            ] ifFalse:[

                ('-_.*' includes:c) ifTrue:[

                    ws nextPut:c.

                ] ifFalse:[

                    ws nextPut: $%.

                    c codePoint printOn:ws base:16.

                ].

            ].

        ].

    ].

    ^ ws contents

    "

     self new escape:'a b'      

     self new escape:'a%b'    

     self new escape:'a b'      

     self new escape:'a+b'      

    "

! !

!HTMLUtilities class methodsFor:'serving-helpers'!

escape:aString

    "helper to escape invalid/dangerous characters in an urls arguments or post-fields.

     These are:

        control characters, '+', ';', '?', '&' and space -> %XX ascii as hex digits

        %     -> %%

    "

    | rs ws c |

    rs := ReadStream on: aString.

    ws := WriteStream on: ''.

    [ rs atEnd ] whileFalse: [

        c := rs next.

        c == $% ifTrue:[

            ws nextPutAll: '%%'.

        ] ifFalse:[

            ((c codePoint < 16r7F)

             and:[ ('+;?& ' includes:c) not ]) ifTrue: [ 

                ws nextPut: c.

            ] ifFalse:[

                ws nextPut: $%.

                c codePoint printOn:ws base:16.

            ]

        ]

    ].

    ^ ws contents

    "

     self escape:'a b'      

     self escape:'a%b'    

     self escape:'a b'      

     self escape:'a+b'      

     self escape:'aäüöb'      

    "

! !

!HTMLUtilities class methodsFor:'documentation'!

version

    ^ '$Header: /cvs/stx/stx/libbasic2/HTMLUtilities.st,v 1.1 2008-12-03 12:23:06 cg Exp $'

! !