Patch title: Release 85 bulk changes
Abstract:
File: /pliant/protocol/http/common/cache.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/unsafe.pli"
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/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
type ImageCache
  inherit CachePrototype
  field Link:ImagePrototype image ; field Str format options
  field Str file ; field CBool temp
  field Link:ImagePrototype image ; field Str format options
  field Str file ; field CBool temp
  field DateTime cached_on
  field Sem sem


gvar (Dictionary Str ImageCache) image_cache
gvar Sem image_cache_sem
gvar Int image_cache_image_count := 0
gvar Int image_cache_file_count := 0
gvar Int image_cache_name_count := 0
gvar DateTime image_cache_last_shrink := datetime
CachePrototype maybe ImageCache


gvar Float image_cache_timeout := 120
gvar Int image_cache_image_limit := 16
gvar Int image_cache_file_limit := 256
gvar Int image_cache_name_limit := 4096
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


function image_cache_shrink
  var DateTime now := datetime
  var CBool image_shrink := image_cache_image_count>=image_c
  var CBool file_shrink := image_cache_file_count>=image_cac
  var CBool name_shrink := image_cache_name_count>=image_cac
  if now:seconds-image_cache_last_shrink:seconds<image_cache
    if not image_shrink and not file_shrink and not name_shr
      return
  var (Index DateTime Str) keys
  each ca image_cache
    keys insert ca:cached_on (image_cache key ca)
  each k keys
    var Pointer:ImageCache ca :> image_cache first k
    var CBool timeout := now:seconds-ca:cached_on:seconds>=i
    if (exists ca:image)
      if timeout
        image_cache remove ca
        image_cache_image_count -= 1
      eif (image_shrink and image_cache_image_count>=image_c
  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 file := file_temporary ; ca temp := true
        ca:image save ca:file "filter [dq]."+ca:format+"[dq]
        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 image :> null map ImagePrototype
        image_cache_image_count -= 1
        image_cache_file_count += 1
    eif ca:temp
      if timeout or (file_shrink and image_cache_file_count>
        image_cache remove ca
        image_cache_file_count -= 1
    else
      if timeout or (name_shrink and image_cache_name_count>
        image_cache remove ca
        image_cache_name_count -= 1
  image_cache_last_shrink := now
      ca:sem release



function image_cache_record image id0 format options -> url
  oarg_rw ImagePrototype image ; arg Str id0 format options 
function image_cache_record image id0 format options -> url
  oarg_rw ImagePrototype image ; arg Str id0 format options 
  var ImageCache ca
  ca format := format ; ca options := options
  var CBool lazy := not (options option "no_lazy")
  if lazy
    ca image :> image
  else
    ca file := file_temporary ; ca temp := true
    image save ca:file "filter [dq]."+format+"[dq] "+options
  var Str id := id0
  if id=""
    id := generate_id+"_"+(replace (base64_alt_encode random
  var Str id := id0
  if id=""
    id := generate_id+"_"+(replace (base64_alt_encode random
  ca cached_on := datetime
  image_cache_sem request
  image_cache_shrink
  image_cache insert id ca
  if lazy
    image_cache_image_count += 1
  else
    image_cache_file_count += 1
  image_cache_sem release
  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
  url := "/common/image/"+id+"."+format

function image_cache_record file id0 format options -> url
  arg Str file id0 format options url
  var ImageCache ca
  ca format := format ; ca options := options
  ca file := file ; ca temp := false
  var Str id := id0
  if id=""
    id := generate_id+"_"+(replace (base64_alt_encode random
  var Str id := id0
  if id=""
    id := generate_id+"_"+(replace (base64_alt_encode random
  ca cached_on := datetime
  image_cache_sem request
  image_cache_shrink
  image_cache insert id ca
  image_cache_name_count += 1
  image_cache_sem release
  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 sta
  url := "/common/image/"+id+"."+format


method page image_cache_send id -> status
  arg_rw HtmlPage page ; arg Str id ; arg ExtendedStatus sta
  image_cache_sem request
  var Pointer:ImageCache pca :> image_cache first id
  if exists:pca
    var ImageCache ca := pca
    image_cache remove pca
    image_cache_sem release
  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)
    if (exists ca:image)
      image_cache_image_count -= 1
    eif ca:temp
      image_cache_file_count -= 1
    else
      image_cache_name_count -= 1
    if (exists ca:image)
      page reset_http_answer
      page reset_http_answer
      page:http_request answer_mime_type := "image/"+ca:form
      page:http_request send_header
      status := ca:image save page:http_request:stream "filt
      var Pointer:HttpRequest r :> page http_request
      request answer_mime_type := "image/"+ca:format
      request answer_is_dynamic := false
      request send_header
      status := ca:image save request:stream "filter [dq]."+ca:format+"[dq] "+ca:options
      request send_footer
    else
      page reset_http_answer
    else
      page reset_http_answer
      status := page:http_request send_static_file ca:file "
      if ca:temp
        file_delete ca:file
      status := request send_static_file ca:file "mime [dq]image/"+ca:format+"[dq] "+ca:options
    ca:sem rd_release
  else
  else
    image_cache_sem release
    status := failure
    status := failure "no such image in the cache" # DO NOT CHANGE


export image_cache_timeout image_cache_image_limit image_cac
export image_cache_record '. image_cache_send'

export image_cache_record '. image_cache_send'