Patch title: Release 85 bulk changes
Abstract:
File: /pliant/appli/database/file.pli
Key:
    Removed line
    Added line
   
abstract
  [Handles datas stored in a file, using HTML like tags.]


gvar List_ database_modified_list ; gvar Sem database_modifi
gvar Int database_modified_count := 0
abstract
  [Handles datas stored in a file, using HTML like tags.]


gvar List_ database_modified_list ; gvar Sem database_modifi
gvar Int database_modified_count := 0
gvar Int database_handle_count := 0
gvar Int database_handle_limit := 256


method df log_required -> required
  arg_rw DatabaseFile df ; arg CBool required
  if df:common:flags:database_loading
    return false
  if not df:common:flags:database_modified
    df set_modified
    if auto_store
      daemon "database autostore daemon"
        while database_modified_count>0 and not daemon_emerg
          daemon_sleep auto_store_step
          data_store false
  if df:logname:len=0
    return false
  df wr_counter += 1
  if (addressof df:log)=null


method df log_required -> required
  arg_rw DatabaseFile df ; arg CBool required
  if df:common:flags:database_loading
    return false
  if not df:common:flags:database_modified
    df set_modified
    if auto_store
      daemon "database autostore daemon"
        while database_modified_count>0 and not daemon_emerg
          daemon_sleep auto_store_step
          data_store false
  if df:logname:len=0
    return false
  df wr_counter += 1
  if (addressof df:log)=null
    atomic_add database_handle_count 1
    if database_handle_count>database_handle_limit
      daemon "database autoclose daemon"
        data_store false
    df log :> new Stream
    if df:logname=df:filename
      # temporary log
      df:log open df:filename append+linecache+safe
    else
      # full log
      var FileInfo info := file_query df:logname standard
      df:log open df:filename append+safe
      df:log writeline "<precovery offset=[dq]"+string:(shun
      df:log close
      df:log open df:logname append+linecache+safe
    if df:log=failure
      df log :> null map Stream
      return false
  var Link:Str lt :> data_read_login_tag
  if (addressof df:login_tag)<>addressof:lt
    df log_line lt
    df login_tag :> lt
  required := true


method df log_recompress
  oarg_rw DatabaseFile df
  if not df:common:flags:database_compressed or df:logname=d
    return
  var Intn logsize := (file_query df:logname standard) size
  (var Stream s) open df:logname in+safe
  s configure "seek "+(string logsize*2\3)
  var CBool binary := false
  for (var Int i) 0 255
    s raw_read addressof:(var uInt8 b) 1
    if b>=128
      binary := true
  s close
  if binary # most of the log file is already compressed
    return
  database_store_sem rd_request
  database_trace trace "recompressing log file " df:logname
  df:common:sem request "aquire database semaphore (log_reco
  if (exists df:log)
    df:log close
    df log :> null map Stream
    df log :> new Stream
    if df:logname=df:filename
      # temporary log
      df:log open df:filename append+linecache+safe
    else
      # full log
      var FileInfo info := file_query df:logname standard
      df:log open df:filename append+safe
      df:log writeline "<precovery offset=[dq]"+string:(shun
      df:log close
      df:log open df:logname append+linecache+safe
    if df:log=failure
      df log :> null map Stream
      return false
  var Link:Str lt :> data_read_login_tag
  if (addressof df:login_tag)<>addressof:lt
    df log_line lt
    df login_tag :> lt
  required := true


method df log_recompress
  oarg_rw DatabaseFile df
  if not df:common:flags:database_compressed or df:logname=d
    return
  var Intn logsize := (file_query df:logname standard) size
  (var Stream s) open df:logname in+safe
  s configure "seek "+(string logsize*2\3)
  var CBool binary := false
  for (var Int i) 0 255
    s raw_read addressof:(var uInt8 b) 1
    if b>=128
      binary := true
  s close
  if binary # most of the log file is already compressed
    return
  database_store_sem rd_request
  database_trace trace "recompressing log file " df:logname
  df:common:sem request "aquire database semaphore (log_reco
  if (exists df:log)
    df:log close
    df log :> null map Stream
    atomic_add database_handle_count -1
  database_recode df:logname "zlib"
  df base_size := (file_query df:logname standard) size
  df:common:sem release
  database_store_sem rd_release

method df store -> status
  oarg_rw DatabaseFile df ; arg Status status
  df:sem rd_request "aquire database semaphore (store) "+df:
  df:rdsem request "aquire database io semaphore (store) "+d
  if df:common:flags:database_modified
    if (exists df:log)
      df:log close
      df log :> null map Stream
  database_recode df:logname "zlib"
  df base_size := (file_query df:logname standard) size
  df:common:sem release
  database_store_sem rd_release

method df store -> status
  oarg_rw DatabaseFile df ; arg Status status
  df:sem rd_request "aquire database semaphore (store) "+df:
  df:rdsem request "aquire database io semaphore (store) "+d
  if df:common:flags:database_modified
    if (exists df:log)
      df:log close
      df log :> null map Stream
      atomic_add database_handle_count -1
    status := df do_store df:filename
    df base_size := (file_query df:logname standard) size
    if status=success
      df clear_modified
  else
    status := success
  df:rdsem release
  df:sem rd_release



function data_store force
  arg CBool force
  var CBool hour_force := false
  var DateTime now := datetime
  hour_sem request
  if now:hour<>hour_current
    hour_stats hour_current := hour_wr_counter
    hour_current := now hour ; hour_wr_counter := 0
    if hour_current=0
      hour_best := 0
      for (var Int i) 1 23
        if hour_load:i<hour_load:hour_best
          hour_best := i
    if hour_current=hour_best or hour_load:hour_current=0
      hour_force := true
  hour_sem release
  var List l
  database_modified_sem rd_request
  var Pointer:ListNode_ n :> database_modified_list first
  while exists:n
    constant modified_node_offset (DatabaseFile field_offset
    var Link:DatabaseFile df :> (addressof:n translate Byte 
    if (df:sem nowait_request)
      hour_sem request
      hour_wr_counter += df wr_counter
      df wr_counter := 0
      hour_sem release
      df:sem release
    var Intn size := (file_query df:logname standard) size
    status := df do_store df:filename
    df base_size := (file_query df:logname standard) size
    if status=success
      df clear_modified
  else
    status := success
  df:rdsem release
  df:sem rd_release



function data_store force
  arg CBool force
  var CBool hour_force := false
  var DateTime now := datetime
  hour_sem request
  if now:hour<>hour_current
    hour_stats hour_current := hour_wr_counter
    hour_current := now hour ; hour_wr_counter := 0
    if hour_current=0
      hour_best := 0
      for (var Int i) 1 23
        if hour_load:i<hour_load:hour_best
          hour_best := i
    if hour_current=hour_best or hour_load:hour_current=0
      hour_force := true
  hour_sem release
  var List l
  database_modified_sem rd_request
  var Pointer:ListNode_ n :> database_modified_list first
  while exists:n
    constant modified_node_offset (DatabaseFile field_offset
    var Link:DatabaseFile df :> (addressof:n translate Byte 
    if (df:sem nowait_request)
      hour_sem request
      hour_wr_counter += df wr_counter
      df wr_counter := 0
      hour_sem release
      df:sem release
    var Intn size := (file_query df:logname standard) size
    if force or hour_force or (size<>undefined and size>df:b
    if force or hour_force or (database_handle_count>database_handle_limit and df:common:flags:database_autoclose) or (size<>undefined and size>df:base_size*3\2+df:growth)
      if df:filename<>""
        l append addressof:df
    n :> n next
  database_modified_sem rd_release
  var Pointer:Arrow c :> l first
  while c<>null
    var Link:DatabaseFile df :> c omap DatabaseFile
    database_trace trace "auto-store " df:filename
    if df:store=success
      df log_recompress
    c :> l next c


method df configure command -> status
  oarg_rw DatabaseFile df ; arg Str command ; arg Status sta
  if compression and command="encoding zlib"
    if not df:common:flags:database_compressed
      database_trace trace "compress " df:filename
      df:sem request "aquire database semaphore (configure) 
      df:common flags += database_compressed
      status := df do_store df:filename
      df base_size := (file_query df:logname standard) size
      if df:logname<>"" and df:logname<>df:filename and stat
        database_recode df:logname "zlib"
      df:sem release
    else
      status := success
  eif command="encoding clear"
    if df:common:flags:database_compressed
      database_trace trace "uncompress " df:filename
      df:sem request "aquire database semaphore (configure) 
      df:common flags -= database_compressed
      status := df do_store df:filename
      df base_size := (file_query df:logname standard) size
      if df:logname<>"" and df:logname<>df:filename and stat
        database_recode df:logname "clear"
      df:sem release
    else
      status := success
  eif (command parse "growth" df:growth)
    status := success
      if df:filename<>""
        l append addressof:df
    n :> n next
  database_modified_sem rd_release
  var Pointer:Arrow c :> l first
  while c<>null
    var Link:DatabaseFile df :> c omap DatabaseFile
    database_trace trace "auto-store " df:filename
    if df:store=success
      df log_recompress
    c :> l next c


method df configure command -> status
  oarg_rw DatabaseFile df ; arg Str command ; arg Status sta
  if compression and command="encoding zlib"
    if not df:common:flags:database_compressed
      database_trace trace "compress " df:filename
      df:sem request "aquire database semaphore (configure) 
      df:common flags += database_compressed
      status := df do_store df:filename
      df base_size := (file_query df:logname standard) size
      if df:logname<>"" and df:logname<>df:filename and stat
        database_recode df:logname "zlib"
      df:sem release
    else
      status := success
  eif command="encoding clear"
    if df:common:flags:database_compressed
      database_trace trace "uncompress " df:filename
      df:sem request "aquire database semaphore (configure) 
      df:common flags -= database_compressed
      status := df do_store df:filename
      df base_size := (file_query df:logname standard) size
      if df:logname<>"" and df:logname<>df:filename and stat
        database_recode df:logname "clear"
      df:sem release
    else
      status := success
  eif (command parse "growth" df:growth)
    status := success
  eif command="close auto"
    df:sem request "aquire database semaphore (configure) "+df:common:path
    df:common flags += database_autoclose
    df:sem release
    status := success
  eif command="close manual"
    df:sem request "aquire database semaphore (configure) "+df:common:path
    df:common flags -= database_autoclose
    df:sem release
    status := success
  else
    status := failure



export '. setup' '. store'
export data_store database_recode
  else
    status := failure



export '. setup' '. store'
export data_store database_recode
export database_handle_limit