' Gambas module file

Export

Class Compress

Property Buffered As Boolean
Property ContentType As String
Property Status As String
Property EndOfLine As Integer

'' Return if the response has been sent, i.e. if the [../end] method has been called.
Property Read Done As Boolean

'' @{since 3.19}
''
'' Return a virtual object used for defining the default properties of the cookie sent to the client
Property Read Cookie As _Response_Cookie

'Property LastModified As Date
'Property Read Cache As _ResponseCache

Private $bBuffered As Boolean
Private $sHeader As String
Private $hFile As File
Private $sContentType As String = "text/html;charset=utf-8"
Private $sStatus As String
Private $iBegin As Integer
'Private $dLastModified As Date
Private $bCompressionComponentChecked As Boolean
Private $bCanUseCompression As Boolean
Private $hComp As Compress
Private $bDone As Boolean

Public Sub AddHeader(Name As String, Value As String)

  If Not Value Then Return  
  $sHeader &= Name & ": " & Value & "\r\n"
  
End

Public Sub Redirect(URL As String)
  
  If $iBegin Then Return
  
  If URL Like "*://*" Then 
    AddHeader("Location", URL)
  Else 
    AddHeader("Location", Main.GetAbsoluteURL(URL))
  Endif
  
  Response.Buffered = False
  Response.Begin
  Response.End
  
End

Public Sub SetCookie(Cookie As String, Value As String, Optional Domain As String, Optional Path As String, Optional Expires As Date, Optional HttpOnly As Boolean)
  
  Dim sVal As String
  Dim sSameSite As String
  
  sVal = Cookie & "=" & Value
  
  If IsMissing(Domain) Then Domain = _Response_Cookie.Domain
  If Domain Then sVal &= ";Domain=" & Domain
  
  If IsMissing(Expires) Then Expires = _Response_Cookie.Expires
  If Expires Then sVal &= ";Expires=" & CGI.FormatDate(Expires)
  
  If IsMissing(Path) Then Path = _Response_Cookie.Path
  If Path Then sVal &= ";Path=" & Path
  
  If IsMissing(HttpOnly) Then HttpOnly = _Response_Cookie.HttpOnly
  If HttpOnly Then sVal &= ";HttpOnly"
  
  sSameSite = _Response_Cookie.SameSite
  If Not sSameSite Then sSameSite = "Lax"
  sVal &= ";SameSite=" & sSameSite
  
  If _Response_Cookie.Secure Or If sSameSite = "None" Then sVal &= ";Secure"
  
  AddHeader("Set-Cookie", sVal)
  
End

Public Sub RemoveCookie(Cookie As String, Value As String, Optional Domain As String, Optional Path As String)
  
  Dim sVal As String
  
  sVal = Cookie & "=" & Value
  If Domain Then sVal &= ";domain=" & Domain
  sVal &= ";expires=Thu, 01 Jan 1970 00:00:00 GMT"
  If Path Then sVal &= ";path=" & Path
  sVal &= ";SameSite=Lax"
  
  AddHeader("Set-Cookie", sVal)
  
End

Public Sub Begin(Optional ContentType As String)

  Inc $iBegin
  If $iBegin <> 1 Then Return 
  
  If ContentType Then $sContentType = ContentType
  If $sStatus Then AddHeader("Status", $sStatus)
  AddHeader("Content-type", $sContentType)
  'AddHeader("Cache-control", "private")
  
  If $bBuffered Then
  
    $hFile = Open Temp$("response") For Create
    $hFile.EndOfLine = File.Out.EndOfLine
    Output To #$hFile
    
  Else
  
    Print $sHeader
    $sHeader = ""
    
  Endif
  
End

Private Sub CloseTempFile()

  Output To Default 
  File.Out.EndOfLine = $hFile.EndOfLine
  Close #$hFile
  $hFile = Null
  
End

'' Reset the response contents.
''
'' Use the [../cancel] method instead.

Public Sub Reset()
  
  $sHeader = ""
  $sStatus = ""
  $sContentType = "text/html;charset=utf-8"

  If $hFile
    Try CloseTempFile
    Try Kill Temp$("response")
  Endif
  
End

'' Try to cancel the response.
''
'' This method will fail if the response is not buffered and has been partially sent.

Public Sub Cancel()
  
  If Not $bBuffered Then
    If $iBegin Then Error.Raise("Response has been started")
    Return
  Endif
  
  If $bDone Then Error.Raise("Response has been sent")
  
  If $iBegin Then
    $iBegin = 0
    Reset
  Endif
  
End

Private Sub ShouldCompress() As Boolean
  
  Return $sContentType Begins "text/"
  
End

Private Sub CanUseCompression() As Boolean

  If Not $bCompressionComponentChecked Then
    Try Component.Load("gb.compress")
    $bCanUseCompression = Not Error
    $bCompressionComponentChecked = True
    $hComp = New Compress
    $hComp.Type = "zlib"
  Endif
  
  Return $bCanUseCompression

End

Public Sub End()
  
  Dim sBuffer As String
  Dim sFile As String
  Dim iSize As Long
  
  'Dim hLog As File

  Dec $iBegin
  If $iBegin <> 0 Then Return

  If $bBuffered Then
  
    CloseTempFile
    
    sFile = Temp$("response")
    
    If ShouldCompress() Then
      If Split(CGI["HTTP_ACCEPT_ENCODING"], ",").Exist("gzip*", gb.Like) Then
        iSize = Stat(sFile).Size
        If iSize >= 512 Then
          If CanUseCompression() Then
            AddHeader("Content-Encoding", "gzip")
            AddHeader("Vary", "Accept-Encoding")
            $hComp.File(sFile, sFile & ".gz", $hComp.Max)
            If Exist(sFile & ".gz") Then sFile &= ".gz"
          Endif
        Endif
      Endif
    Endif

    $hFile = Open sFile For Read 
    AddHeader("Content-Length", Lof($hFile))
    Print $sHeader
    $sHeader = ""
  
    While Not Eof($hFile)
      sBuffer = Read #$hFile, -65536
      Print sBuffer;
      'Print #hLog, sBuffer;
    Wend
    Close #$hFile
    
  Else
    
    Flush
    
  Endif
  
  $bDone = True
  Reset()
  
'Catch
  
'  Main.Log(Error.Where & ": " & Error.Text, True)
  
End

Public Sub GetContentTypeFrom(Path As String) As String
  
  Select Case Lower(File.Ext(Path))
    Case "css"
      Return "text/css;charset=utf-8"
    Case "jpg", "jpeg", "jpe", "thumb"
      Return "image/jpeg"
    Case "png"
      Return "image/png"
    Case "gif"
      Return "image/gif"
    Case "svg"
      Return "image/svg+xml"
    Case "tiff", "tif"
      Return "image/tiff"
    Case "js"
      Return "text/javascript;charset=utf-8"
    Case "odt"
      Return "application/vnd.oasis.opendocument.text"
    Case "doc"
      Return "application/msword"
    Case "ods"
      Return "application/vnd.oasis.opendocument.spreadsheet"
    Case "xls"
      Return "application/msexcel"
    Case "pdf"
      Return "application/pdf"
    Case "zip"
      Return "application/zip"
    Case "html", "htm"
      Return "text/html;charset=utf-8"
    Case "txt"
      Return "text/plain;charset=utf-8"
    Case "avi"
      Return "video/x-msvideo"
    Case "mpg", "mpeg"
      Return "video/mpeg"
    Case "ps"
      Return "application/postscript"
    Case "dwg"
      Return "application/acad"
    Case "wav"
      Return "audio/x-wav"
    Case "ogg"
      Return "application/ogg"
    Case "jar"
      Return "application/x-jar"
    Case "json"
      Return "application/json;charset=utf-8"
    Case "kml"
      Return "application/vnd.google-earth.kml+xml"
    Case "kmz"
      Return "application/vnd.google-earth.kmz"
    Case Else 
      Return "application/octet-stream"
  End Select
  
End

Public Sub SendFile(Path As String, Optional ContentType As String)
  
  Dim sBuffer As String
  Dim hFile As File

  $bDone = True

  Path = File.RealPath(Path, True)

  If Not Exist(Path) Then
    Print "Status: 404 Not Found"
    Print
    Return
  Endif

  If Not ContentType Then ContentType = GetContentTypeFrom(Path)
  Print "Content-Type: "; ContentType
  Print $sHeader;
  
  hFile = Open Path For Read 

  Print "Content-length: "; Lof(hFile)
  Print
  While Not Eof(hFile)
    sBuffer = Read #hFile, -1024
    Print sBuffer;
  Wend
  Close #hFile
  
End


Private Function Buffered_Read() As Boolean

  Return $bBuffered  

End

Private Sub Buffered_Write(Value As Boolean)

  If $bBuffered And If Not Value Then $iBegin = 0

  $bBuffered = Value

End

Private Function ContentType_Read() As String

  Return $sContentType  

End

Private Sub ContentType_Write(Value As String)

  $sContentType = Value  

End

Private Function Status_Read() As String

  Return $sStatus

End

Private Sub Status_Write(Value As String)

  $sStatus = Value

End
' 
' Private Function Cache_Read() As _ResponseCache
' 
'   Return _ResponseCache
' 
' End
' 
' Private Function LastModified_Read() As Date
' 
'   Return $dLastModified
' 
' End
' 
' Private Sub LastModified_Write(Value As Date)
' 
'   $dLastModified = Value
' 
' End

Private Function EndOfLine_Read() As Integer

  Return File.Out.EndOfLine

End

Private Sub EndOfLine_Write(Value As Integer)

  File.Out.EndOfLine = Value

End

Private Function Done_Read() As Boolean

  Return $bDone

End

Private Function Cookie_Read() As _Response_Cookie

  Return _Response_Cookie

End
