Patch title: Release 84 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.]


constant auto_store true
constant auto_store_step 5
abstract
  [Handles datas stored in a file, using HTML like tags.]


constant auto_store true
constant auto_store_step 5
constant auto_store_mini 4*3600
constant auto_store_maxi 24*3600
constant verbose false
constant debug false
constant compression os_zlib_filename<>""


public
  type DatabaseFile
    field Database_ common
    field Sem rwsem rdsem
    field Link:DataInterface_ root_interface
    field Str filename
constant verbose false
constant debug false
constant compression os_zlib_filename<>""


public
  type DatabaseFile
    field Database_ common
    field Sem rwsem rdsem
    field Link:DataInterface_ root_interface
    field Str filename
    field DateTime first_modified_on last_modified_on
    field Int store_interval_mini <- auto_store_mini
    field Int store_interval_maxi <- auto_store_maxi
    field Str logname ; field Link:Stream log ; field Link:S
    field Str logname ; field Link:Stream log ; field Link:S
    field Intn base_size growth <- 0
    field Int wr_counter <- 0
    field ListNode_ all_node modified_node


method df set_modified
  arg_rw DatabaseFile df
    field ListNode_ all_node modified_node


method df set_modified
  arg_rw DatabaseFile df
  if not df:common:flags:database_remodified
    df:common flags += database_remodified
    df last_modified_on := datetime
  if not df:common:flags:database_modified
    df:common flags += database_modified
    database_modified_sem request
    database_modified_list append df:modified_node
    database_modified_count += 1
    database_modified_sem release
  if not df:common:flags:database_modified
    df:common flags += database_modified
    database_modified_sem request
    database_modified_list append df:modified_node
    database_modified_count += 1
    database_modified_sem release
    df first_modified_on := datetime


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


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
    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
  if (addressof df:log)=null
    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
  database_trace trace "recompressing log file " df:logname
  df:common:sem request
  df:common:sem request "aquire database semaphore (log_recompress) "+df:common:path
  if (exists df:log)
    df:log close
    df log :> null map Stream
  database_recode df:logname "zlib"
  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
  df:common:sem release
  database_store_sem rd_release

method df store -> status
  oarg_rw DatabaseFile df ; arg Status status

method df store -> status
  oarg_rw DatabaseFile df ; arg Status status
  df:sem rd_request
  df:rdsem request
  df:sem rd_request "aquire database semaphore (store) "+df:common:path
  df:rdsem request "aquire database io semaphore (store) "+df:common:path
  if df:common:flags:database_modified
    if (exists df:log)
      df:log close
      df log :> null map Stream
    status := df do_store df:filename
  if df:common:flags:database_modified
    if (exists df:log)
      df:log close
      df log :> null map Stream
    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


method df setup filename logname mountpoint
  oarg_rw DatabaseFile df ; arg Str filename logname mountpo
    if status=success
      df clear_modified
  else
    status := success
  df:rdsem release
  df:sem rd_release


method df setup filename logname mountpoint
  oarg_rw DatabaseFile df ; arg Str filename logname mountpo
  df:sem request
  df:sem request "aquire database semaphore (setup) "+df:common:path
  df filename := filename
  df logname := logname
  df path := mountpoint # setting the path before loading is
  df filename := filename
  df logname := logname
  df path := mountpoint # setting the path before loading is
  df do_load filename
  df do_load filename df:base_size
  if mountpoint<>""
    data_mount df mountpoint
  if mountpoint<>""
    data_mount df mountpoint
  if df:base_size=undefined
    df base_size := (file_query df:logname standard) size
  else
    df set_modified  
  df:sem release


  df:sem release


gvar Array:Int hour_stats # per hours statistics about activity
function init_hour_stats
  hour_stats size := 24
  for (var Int i) 0 23
    hour_stats i := 0
init_hour_stats
gvar Int hour_current := 0
gvar Int hour_wr_counter := 0
gvar Int hour_best := 0
gvar Sem hour_sem

function hour_load h -> l
  arg Int h ; arg Int l
  l := (hour_stats (h+22)%24)+2*(hour_stats (h+23)%24)+4*hour_stats:h+2*(hour_stats (h+1)%24)+(hour_stats (h+2)%24)

function data_store force
  arg CBool force
function data_store force
  arg CBool force
  var List l
  var CBool hour_force := false
  var DateTime now := datetime
  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 
  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:common:flags:database_remodified and df:sem:nowait
      df:common flags -= database_remodified
    if (df:sem nowait_request)
      hour_sem request
      hour_wr_counter += df wr_counter
      df wr_counter := 0
      hour_sem release
      df:sem release
      df:sem release
    if force or now:seconds>=df:last_modified_on:seconds+df:
    var Intn size := (file_query df:logname standard) size
    if force or hour_force 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
      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
      df:sem request "aquire database semaphore (configure) "+df:common:path
      df:common flags += database_compressed
      status := df do_store df:filename
      df:common flags += database_compressed
      status := df do_store df:filename
      if df:logname<>df:filename and df:logname<>"" and stat
      df base_size := (file_query df:logname standard) size
      if df:logname<>"" and df:logname<>df:filename and status=success
        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
        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
      df:sem request "aquire database semaphore (configure) "+df:common:path
      df:common flags -= database_compressed
      status := df do_store df:filename
      df:common flags -= database_compressed
      status := df do_store df:filename
      if df:logname<>df:filename and df:logname<>"" and stat
      df base_size := (file_query df:logname standard) size
      if df:logname<>"" and df:logname<>df:filename and status=success
        database_recode df:logname "clear"
      df:sem release
    else
      status := success
        database_recode df:logname "clear"
      df:sem release
    else
      status := success
  eif (command parse "store_interval" (var Int mi) (var Int 
    df store_interval_mini := mi
    df store_interval_maxi := ma
  eif (command parse "growth" df:growth)
    status := success
  else
    status := failure


    status := success
  else
    status := failure


gvar CBool on := true

function data_write_off
  if on
    database_all_sem rd_request
    var Pointer:ListNode_ n :> database_all_list first
    while exists:n
      constant all_node_offset (DatabaseFile field_offset "a
      var Link:DatabaseFile df :> (addressof:n translate Byt
      df:sem rd_request
      n :> n next
    on := false

function data_write_on
  if not on
    var Pointer:ListNode_ n :> database_all_list first
    while exists:n
      constant all_node_offset (DatabaseFile field_offset "a
      var Link:DatabaseFile df :> (addressof:n translate Byt
      df:sem rd_release
      n :> n next
    database_all_sem rd_release
  on := true

export data_write_on data_write_off


function data_file_switch src dest -> status
  arg Str src dest ; arg Status status
  status := failure
  database_all_sem rd_request
  var Pointer:ListNode_ n :> database_all_list first
  while exists:n
    constant all_node_offset (DatabaseFile field_offset "all
    var Link:DatabaseFile df :> (addressof:n translate Byte 
    if df:filename=dest or (file_os_name df:filename)=file_o
function data_file_switch src dest -> status
  arg Str src dest ; arg Status status
  status := failure
  database_all_sem rd_request
  var Pointer:ListNode_ n :> database_all_list first
  while exists:n
    constant all_node_offset (DatabaseFile field_offset "all
    var Link:DatabaseFile df :> (addressof:n translate Byte 
    if df:filename=dest or (file_os_name df:filename)=file_o
      df:sem request
      df:sem request "aquire database semaphore (data_file_switch) "+df:common:path
      file_move src dest
      file_directory_flush dest
      df do_load df:filename
      df clear_modified
      df:sem release
      status := success
    n :> n next
  database_all_sem rd_release


function load_databases parameter filehandle
  arg Address parameter ; arg Int filehandle
      file_move src dest
      file_directory_flush dest
      df do_load df:filename
      df clear_modified
      df:sem release
      status := success
    n :> n next
  database_all_sem rd_release


function load_databases parameter filehandle
  arg Address parameter ; arg Int filehandle
  data_write_on
  var Pointer:ListNode_ n :> database_all_list first
  while exists:n
    constant all_node_offset (DatabaseFile field_offset "all
    var Link:DatabaseFile df :> (addressof:n translate Byte 
    df do_load df:filename
    df clear_modified
    n :> n next
gvar DelayedAction da0
da0 function :> the_function load_databases Address Int
pliant_restore_actions append addressof:da0

  var Pointer:ListNode_ n :> database_all_list first
  while exists:n
    constant all_node_offset (DatabaseFile field_offset "all
    var Link:DatabaseFile df :> (addressof:n translate Byte 
    df do_load df:filename
    df clear_modified
    n :> n next
gvar DelayedAction da0
da0 function :> the_function load_databases Address Int
pliant_restore_actions append addressof:da0

function wakeup_databases parameter
  arg Address parameter
  data_write_on
gvar DelayedAction da1
da1 function :> the_function wakeup_databases Address
pliant_wakeup_actions append addressof:da1


function shutdown_databases parameter
  arg Address parameter
  data_write_off
  data_store
gvar DelayedAction da2
da2 function :> the_function shutdown_databases Address
pliant_shutdown_actions append addressof:da2


export '. setup' '. store'
export '. setup' '. store'
export data_store data_write_off data_write_on database_reco
export data_store database_recode