Patch title: Release 87 bulk changes
Abstract:
File: /pliant/protocol/http/cache.pli
Key:
    Removed line
    Added line
module "/pliant/language/unsafe.pli"
module "/pliant/language/context.pli"
module "/pliant/admin/file.pli"
module "/pliant/graphic/image/prototype.pli"
module "/pliant/graphic/filter/io.pli"
module "/pliant/protocol/http/server.pli"
module "/pliant/language/data/id.pli"
module "/pliant/util/crypto/random.pli"
module "/pliant/util/encoding/base64.pli"
module "/pliant/language/data/cache.pli"
module "/pliant/language/compiler/type/inherit.pli"

module "/pliant/language/stream.pli"

constant force_to_disk true


gvar Sem disk_sem
gvar Int disk_current_count := 0
gvar Int disk_assigned_count := 1024
gvar Intn disk_current_size := 0
gvar Intn disk_assigned_size := 64*2^20

function disk_setup count size
  arg Int count ; arg Intn size
  disk_sem request
  disk_assigned_count := count
  disk_assigned_size := size
  disk_sem release

function disk_shrink
  disk_sem request
  var CBool overflow := disk_current_count>disk_assigned_count or disk_current_size>disk_assigned_size
  disk_sem release
  if overflow
    cache_shrink 0 cache_class_costy # FIXME: not very smart

export disk_setup


type ImageCache
  inherit CachePrototype
  field Link:ImagePrototype image ; field Str format options
  field Str file ; field CBool temp
  field Sem sem

CachePrototype maybe ImageCache

method ca drop
  arg_rw ImageCache ca
  if ca:temp
    var Intn fsize := (file_query ca:file standard) size
    file_delete ca:file
    disk_sem request ; disk_current_count -= 1 ; disk_current_size -= fsize ; disk_sem release

if force_to_disk

  type ImageForceToDisk
    inherit CachePrototype
    field Str id
  
  CachePrototype maybe ImageForceToDisk
  
  method f drop
    arg_rw ImageForceToDisk f
    var Link:ImageCache ca
    if (cache_search "/pliant/image/"+f:id ((addressof Link:ImageCache ca) map Link:CachePrototype))
      ca:sem request
      if (exists ca:image)
        disk_shrink
        ca file := file_temporary ; ca temp := true
        ca:image save ca:file "filter [dq]."+ca:format+"[dq] "+ca:options
        var Intn fsize := (file_query ca:file standard) size
        disk_sem request ; disk_current_count += 1 ; disk_current_size += fsize ; disk_sem release
        ca image :> null map ImagePrototype
      ca:sem release


function image_cache_record image id0 format options -> url
  oarg_rw ImagePrototype image ; arg Str id0 format options url
  var Str id := id0
  if id=""
    id := generate_id+"_"+(replace (base64_alt_encode random_string:16) "." "")
  var Link:ImageCache ca
  if (cache_open "/pliant/image/"+id ImageCache ((addressof Link:ImageCache ca) map Link:CachePrototype))
    ca format := format ; ca options := options
    var CBool lazy := not (options option "no_lazy")
    if lazy
      ca image :> image
      if force_to_disk
        var Link:ImageForceToDisk f
        if (cache_open "/pliant/image2/"+id ImageForceToDisk ((addressof Link:ImageForceToDisk f) map Link:CachePrototype))
          f id := id
          cache_setup ((addressof Link:ImageForceToDisk f) map Link:CachePrototype) cache_class_cheap
          cache_ready ((addressof Link:ImageForceToDisk f) map Link:CachePrototype)
    else
      disk_shrink
      ca file := file_temporary ; ca temp := true
      image save ca:file "filter [dq]."+format+"[dq] "+options
      var Intn fsize := (file_query ca:file standard) size
      disk_sem request ; disk_current_count += 1 ; disk_current_size += fsize ; disk_sem release
    cache_ready ((addressof Link:ImageCache ca) map Link:CachePrototype)
  url := "/common/image/"+id+"."+format

function image_cache_record file id0 format options -> url
  arg Str file id0 format options url
  var Str id := id0
  if id=""
    id := generate_id+"_"+(replace (base64_alt_encode random_string:16) "." "")
  var Link:ImageCache ca
  if (cache_open "/pliant/image/"+id ImageCache ((addressof Link:ImageCache ca) map Link:CachePrototype))
    ca format := format ; ca options := options
    ca file := file ; ca temp := false
    cache_ready ((addressof Link:ImageCache ca) map Link:CachePrototype)
  url := "/common/image/"+id+"."+format


method page image_cache_send id -> status
  arg_rw HtmlPage page ; arg Str id ; arg ExtendedStatus status
  var Pointer:HttpRequest request :> page http_request
  var Link:ImageCache ca
  if (cache_search "/pliant/image/"+id ((addressof Link:ImageCache ca) map Link:CachePrototype))
    ca:sem rd_request
    if (exists ca:image)
      page reset_http_answer
      request send_header "mime [dq]image/"+ca:format+"[dq] static"
      status := ca:image save request:answer_stream "filter [dq]."+ca:format+"[dq] "+ca:options
      request send_footer
    else
      page reset_http_answer
      status := request send_static_file ca:file "mime [dq]image/"+ca:format+"[dq] "+ca:options
    ca:sem rd_release
  else
    status := failure "no such image in the cache" # DO NOT CHANGE

export image_cache_record '. image_cache_send'