/*
 * Xailer source code:
 *
 * HTTPRequest.prg
 * Peticiones HTTP
 *
 * Copyright 2013 Jose Lalin
 * Copyright 2003, 2013 Xailer.com
 * All rights reserved
 *
 */

#include "xailer.ch"
#include "wininet.api"

//------------------------------------------------------------------------------

CLASS XHTTPRequest FROM TComponent

PUBLISHED:
   PROPERTY cHost          INIT ""
   PROPERTY cQuery         INIT ""
   PROPERTY cParams        INIT ""
   PROPERTY lKeepAlive     INIT .T. WRITE INLINE ::FlKeepAlive := ::SetFlag( INTERNET_FLAG_KEEP_CONNECTION, Value )
   PROPERTY lUrlEncoded    INIT .F.
   PROPERTY lSecure        INIT .F. WRITE INLINE ::FlSecure := ::SetFlag( INTERNET_FLAG_SECURE, Value )
   PROPERTY nBuffer        INIT 2048

   EVENT OnSendRequest( oSender, lSuccess ) // --> Nil
   EVENT OnGetResponse( oSender, hRequest ) // --> Nil

PUBLIC:
   DATA aParams         INIT {} READONLY
   DATA aHeaders        INIT {} READONLY
   DATA cResponse       INIT "" READONLY
   DATA nLastError      INIT 0 READONLY
   DATA oInternet       READONLY AS TInternet
   DATA nStatusCode     INIT 0 READONLY
   DATA cStatusText     INIT "" READONLY
   DATA aResponseHeaders   INIT {}

   METHOD Create( oParent ) CONSTRUCTOR // --> oHTTPRequest
   METHOD Free()

   METHOD Open() // --> lSuccess
   METHOD OpenProxy( cProxy, cByPass, cUser, cPassword ) // --> lSuccess
   METHOD Close()    INLINE ::oInternet:Close() // --> lSuccess

   METHOD SendRequest( nFlags, cMethod )  // --> lSuccess
   METHOD Request( nFlags, cMethod ) // --> lSuccess

   METHOD Delete( nFlags )    INLINE ::SendRequest( nFlags, "DELETE" ) // --> lSuccess
   METHOD Get( nFlags )       INLINE ::SendRequest( nFlags, "GET" ) // --> lSuccess
   METHOD Head( nFlags )      INLINE ::SendRequest( nFlags, "HEAD" ) // --> lSuccess
   METHOD Options( nFlags )   INLINE ::SendRequest( nFlags, "OPTIONS" ) // --> lSuccess
   METHOD Post( nFlags )      INLINE ::SendRequest( nFlags, "POST" ) // --> lSuccess
   METHOD Put( nFlags )       INLINE ::SendRequest( nFlags, "PUT" ) // --> lSuccess
   METHOD Trace( nFlags )     INLINE ::SendRequest( nFlags, "TRACE" ) // --> lSuccess
   METHOD Connect( nFlags )   INLINE ::SendRequest( nFlags, "CONNECT" ) // --> lSuccess

   METHOD AddParam( cName, cValue ) // --> Nil
   METHOD AddHeader( cHeader, cValue, nFlags )  INLINE AAdd( ::aHeaders, { cHeader, cValue, nFlags } ) // --> Nil
   METHOD Reset() // --> Nil

   METHOD GetQueryString() // --> cQueryString
   METHOD GetQueryURL() // --> cQueryURL
   METHOD GetQueryParams() // --> cQueryParams

   METHOD GetResponseHeader( cHeader, lValue ) // --> cHeaderContent | cHeaderValue
   METHOD VerifyResponseHeader( cHeader, cValue ) // --> lExist

PROTECTED:
   DATA nFlags       INIT INTERNET_FLAG_KEEP_CONNECTION

   METHOD SetFlag( nFlag, Value )
   METHOD GetResponseCode( hRequest )

ENDCLASS

//------------------------------------------------------------------------------

METHOD SetFlag( nFlag, Value ) CLASS XHTTPRequest

   IF Value
      ::nFlags := nOr( ::nFlags, nFlag )
   ELSE
      ::nFlags := nExclude( ::nFlags, nFlag )
   ENDIF

RETURN Value

//--------------------------------------------------------------------------

METHOD Create( oParent ) CLASS XHTTPRequest

   ::Super:Create( oParent )
   ::oInternet := TInternet():Create()

RETURN Self

//------------------------------------------------------------------------------

METHOD Free() CLASS XHTTPRequest

   ::oInternet:Destroy()
   ::oInternet := Nil
   ::Super:Free()

RETURN Nil

//------------------------------------------------------------------------------

METHOD Reset() CLASS XHTTPRequest

   ::aParams := {}
   ::aHeaders := {}
   ::cResponse := ""
   ::nLastError := 0
   ::nStatusCode := 0
   ::cStatusText := 0
   ::aResponseHeaders := {}

RETURN Nil

//------------------------------------------------------------------------------

METHOD GetQueryString() CLASS XHTTPRequest

   LOCAL cStr := ::cQuery

   IF At( "?", cStr ) == 0
      cStr += "?"
   ENDIF

RETURN cStr

//------------------------------------------------------------------------------

METHOD GetQueryURL() CLASS XHTTPRequest
RETURN ::cHost + ::GetQueryString()

//------------------------------------------------------------------------------

METHOD GetQueryParams() CLASS XHTTPRequest

   LOCAL cStr := ::cParams
   LOCAL cParam

   IF !Empty( cStr ) .AND. ! Empty( ::aParams )
      cStr += "&"
   ENDIF

   FOR EACH cParam IN ::aParams
      IF cParam:__EnumIndex() > 1
         cStr += "&"
      ENDIF
      cStr += cParam
   NEXT

RETURN cStr

//------------------------------------------------------------------------------

METHOD GetResponseCode( hRequest ) CLASS XHTTPRequest

   LOCAL cStatus

   IF ::oInternet:QueryInfo( hRequest, nOr( HTTP_QUERY_STATUS_CODE, HTTP_QUERY_FLAG_NUMBER ), @cStatus )
      ::nStatusCode := cStatus
   ENDIF

   cStatus := Nil
   IF ::oInternet:QueryInfo( hRequest, HTTP_QUERY_STATUS_TEXT, @cStatus )
      ::cStatusText := cStatus
   ENDIF

   cStatus := Nil
   IF ::oInternet:QueryInfo( hRequest, HTTP_QUERY_RAW_HEADERS_CRLF, @cStatus )
      ::aResponseHeaders := hb_aTokens( cStatus, CRLF )
   ENDIF

RETURN Nil

//------------------------------------------------------------------------------

METHOD Open() CLASS XHTTPRequest

   LOCAL lOk := .F.

   WITH OBJECT ::oInternet
      IF ::lSecure
         :nPort := INTERNET_DEFAULT_HTTPS_PORT //INTERNET_DEFAULT_PORT
      ENDIF
      lOk := :Open()
   END

RETURN lOk

//------------------------------------------------------------------------------

METHOD OpenProxy( cProxy, cByPass, cUser, cPassword ) CLASS XHTTPRequest

   LOCAL lOk := .F.

   WITH OBJECT ::oInternet
      IF ::lSecure
         :nPort := INTERNET_DEFAULT_HTTPS_PORT //INTERNET_DEFAULT_PORT
      ENDIF
      lOk := :Open( , cProxy, cByPass, INTERNET_OPEN_TYPE_PROXY )
      IF lOk
         ::oInternet:SetOption( :hSession, INTERNET_OPTION_PROXY_USERNAME, cUser )
         ::oInternet:SetOption( :hSession, INTERNET_OPTION_PROXY_PASSWORD, cPassword )
      ENDIF
   END

RETURN lOk

//------------------------------------------------------------------------------

METHOD AddParam( cName, cValue ) CLASS XHTTPRequest

   IF ! Empty( cName ) .AND. ! Empty( cValue )
      cValue := ::oInternet:CanonicalizeURL( cValue )
      AAdd( ::aParams, cName + "=" + cValue )
   ENDIF

RETURN Nil

//------------------------------------------------------------------------------

METHOD Request( nFlags, cMethod ) CLASS XHTTPRequest

   LOCAL hRequest
   LOCAL cBuffer := Space( ::nBuffer )
   LOCAL cRead := ""
   LOCAL aHead
   LOCAL lSent
   LOCAL cQuery := ::GetQueryString()
   LOCAL cParams := ::GetQueryParams()

   DEFAULT cMethod TO "GET", ;
           nFlags TO 0

   WITH OBJECT ::oInternet
      IF :Connect( ::cHost )
         nFlags := nOr( nFlags, ::nFlags )
         hRequest := :OpenRequest( cMethod, cQuery + cParams, nFlags )

         IF ! Empty( hRequest )
            IF ::lUrlEncoded
               :AddRequestHeader( hRequest, "Content-Type: application/x-www-form-urlencoded" + CRLF )
            ENDIF
            FOR EACH aHead IN ::aHeaders
               IF ! Empty( aHead[1] )
                  :AddRequestHeader( hRequest, AllTrim( ToString( aHead[1] ) ) + ": " + AllTrim( ToString( aHead[2] ) ), aHead[3] )
               ENDIF
            NEXT

            lSent := :SendRequest( hRequest, , cParams )
            ::nLastError := GetLastError()
            ::OnSendRequest( lSent )
            ::GetResponseCode( hRequest )
            ::OnGetResponse( hRequest )

            IF lSent
               WHILE :ReadFile( hRequest, @cBuffer, ::nBuffer )
                  cRead += cBuffer
                  cBuffer := Space( ::nBuffer )
               END
            ENDIF
            ::cResponse := cRead
            :CloseRequest( hRequest )
         ENDIF
      ENDIF
   END

   ::nLastError := GetLastError()

RETURN ::nLastError == 0

//------------------------------------------------------------------------------

METHOD SendRequest( nFlags, cMethod ) CLASS XHTTPRequest

   LOCAL lOk := .F.

   IF ::Open()
      lOk := ::Request( nFlags, cMethod )
      ::Close()
   ENDIF

RETURN lOk

//------------------------------------------------------------------------------

METHOD GetResponseHeader( cHeader, lValue ) CLASS XHTTPRequest

   LOCAL nLen := Len( AllTrim( ToString( cHeader ) ) )
   LOCAL nPos
   LOCAL cReturn := ""

   IF ( nPos := AScan( ::aResponseHeaders, {|x| Upper( Left( x, nLen ) ) == Upper( Left( cHeader, nLen ) ) } ) ) > 0
      DEFAULT lValue TO .F.
      IF lValue
         cReturn := SubStr( ::aResponseHeaders[ nPos ], nLen + 1 )
      ELSE
         cReturn := ::aResponseHeaders[ nPos ]
      ENDIF
      cReturn := AllTrim( cReturn )
   ENDIF

RETURN cReturn

//------------------------------------------------------------------------------

METHOD VerifyResponseHeader( cHeader, cValue ) CLASS XHTTPRequest
RETURN ::GetResponseHeader( cHeader, .T. ) == cValue

//------------------------------------------------------------------------------