Patch title: Release 95 bulk changes
Abstract:
File: /pliant/appli/cluster/common.pli
Key:
    Removed line
    Added line
module "/pliant/language/compiler.pli"
module "/pliant/storage/database/database.pli"
module "/pliant/storage/database.pli"
module "/pliant/admin/file.pli"
module "/pliant/admin/md5.pli"
module "filter.pli"
module "database.pli"


public

  function time_filter_prototype start run fun
    arg_w CBool start run ; arg Function fun
    indirect
  
  function post_process_prototype area fun
    arg_rw Data:ClusterArea area ; arg Function fun
    indirect
  
  function file_filter_prototype path source target base fun-> mode
    arg Str path source target ; arg Int base ; arg Function fun ; arg Int mode
    indirect
  
  function data_filter_prototype data new_value source target base fun -> mode
    arg Data_ data ; arg Str new_value source target ; arg Int base ; arg Function fun ; arg Int mode
    indirect

  # mode: 0 = exclude, 1 = count, 2 = append, 3 = modify, 4 = delete

function data_sign_rec d filter limit count ctx
  arg Data_ d ; arg Function filter ; arg Int limit ; arg_rw Int count ; arg_rw MD5_CTX ctx
  MD5Update ctx "(":characters 1
  if (d:interface get d addressof:(var Str value) Str)=success
    count += 1
    var Str encoded := string value
    MD5Update ctx encoded:characters encoded:len
  var Data_ cur := d:interface first d "" "" (var DataScanBuffer buf)
  while cur:adr<>null
    if count>limit
      return
    if (data_filter_prototype cur "" "" "" 1 filter)>0
      MD5Update ctx " ":characters 1
      var Str encoded := string cur:key
      MD5Update ctx encoded:characters encoded:len
      data_sign_rec cur filter limit count ctx
    cur := d:interface next d "" "" buf
  MD5Update ctx ")":characters 1

function data_sign d filter limit count -> hexsign
  arg_rw Data_ d ; arg Function filter ; arg Int limit ; arg_w Int count ; arg Str hexsign
  var MD5_CTX ctx
  MD5Init ctx
  d:base:sem rd_request
  count := 0
  if (data_filter_prototype d "" "" "" 1 filter)>0
    data_sign_rec d filter limit count ctx
  d:base:sem rd_release
  MD5Final ctx
  hexsign := MD5HexaSignature ctx
  if count>limit
    hexsign := ""
    count := undefined


function file_sign_rec path filter limit count size ctx
  arg Str path ; arg Function filter ; arg Int limit ; arg_rw Int count ; arg_rw Intn size ; arg_rw MD5_CTX ctx
  var Array:FileInfo files := file_list path extended+directories+deadlinks+relative+sorted
  count += files size
  MD5Update ctx "(":characters 1
  for (var Int i) 0 files:size-1
    if count>limit
      return
    if (file_filter_prototype path+files:i:name "" "" 1 filter)>0
      if files:i:is_link
        var Str encoded := " "+(string files:i:name)+" link "+(string files:i:link)
        MD5Update ctx encoded:characters encoded:len
      eif files:i:is_directory
        var Str encoded := " "+(string files:i:name)
        MD5Update ctx encoded:characters encoded:len
        file_sign_rec path+files:i:name filter limit count size ctx
      else
        size += files:i:size
        var Str encoded := " "+(string files:i:name)+" "+(string files:i:size)+" "+(string files:i:datetime)
        MD5Update ctx encoded:characters encoded:len
  MD5Update ctx ")":characters 1

function file_sign path filter limit count size -> hexsign
  arg Str path ; arg Function filter ; arg Int limit ; arg_w Int count ; arg_w Intn size ; arg Str hexsign
  if (path:len>0 and (path path:len-1)<>"/")
    return file_md5_hexa_signature:path
  var MD5_CTX ctx
  MD5Init ctx
  count := 0 ; size := 0
  if (file_filter_prototype path "" "" 1 filter)>0
    file_sign_rec path filter limit count size ctx
  MD5Final ctx
  hexsign := MD5HexaSignature ctx
  if count>limit
    hexsign := ""


gvar Dictionary formula
gvar Sem sem

function no_time_filter start run
  arg_w CBool start run
  start := true
  run := true

function no_post_process area
  arg_rw Data:ClusterArea area
  
function no_file_filter path source target base -> mode
  arg Str path source target ; arg Int base mode
  mode := base

function no_data_filter data new_value source target base -> mode
  arg Data_ data ; arg Str new_value source target ; arg Int base mode
  mode := base


function cluster_filter area category err -> fun
  arg Data:ClusterArea area ; arg Str category ; arg_w Str err ; arg Link:Function fun
  err := ""
  if category="time"
    fun :> the_function no_time_filter CBool CBool
  eif category="post"
    fun :> the_function no_post_process Data:ClusterArea
  eif category="src_file" or category="dest_file"
    fun :> the_function no_file_filter Str Str Str Int -> Int
  eif category="src_data" or category="dest_data"
    fun :> the_function no_data_filter Data_ Str Str Str Int -> Int
  else
    fun :> null map Function
  var Str text := shunt category="time" area:time_filter category="post" area:post_process category="src_file" area:src_file_filter category="dest_file" area:dest_file_filter category="src_data" area:src_data_filter category="dest_data" area:dest_data_filter ""
  if text=""
    return
  var Str id := keyof:area+" "+category
  sem request
  fun :> (formula first id) map Function
  if exists:fun and ((fun:properties first "text") map Str)<>text
    formula remove id addressof:fun
    fun :> null map Function
  if exists:fun
    sem release
    return
  pliant_compiler_semaphore request
  var Str name := "cluster formula "+id
  var Link:List program :> new List
  each m area:module
    program append addressof:(new Str "module "+string:m)
  if category="time"
    program append addressof:(new Str "function '"+name+"' start_flag run_flag")
    program append addressof:(new Str "  arg_w CBool start_flag run_flag")
    program append addressof:(new Str "  start_flag := true")
    program append addressof:(new Str "  run_flag := true")
    program append addressof:(new Str "  implicit datetime")
  eif category="post"
    program append addressof:(new Str "module [dq]/pliant/appli/cluster/database.pli[dq]")
    program append addressof:(new Str "function '"+name+"' area")
    program append addressof:(new Str "  arg_rw Data:ClusterArea area")
    program append addressof:(new Str "  implicit area")
  eif category="src_file" or category="dest_file"
    program append addressof:(new Str "function '"+name+"' path source target base -> mode")
    program append addressof:(new Str "  arg Str path source target ; arg Int base mode")
    program append addressof:(new Str "  mode := base")
    program append addressof:(new Str "  if true")
  eif category="src_data" or category="dest_data"
    program append addressof:(new Str "function '"+name+"' data new_value source target base -> mode")
    program append addressof:(new Str "  arg Data_ data ; arg Str new_value source target ; arg Int base mode")
    program append addressof:(new Str "  mode := base")
    program append addressof:(new Str "  implicit data")
  var Str lines := text
  while lines<>""
    if not (lines eparse any:(var Str line) "[lf]" any:(var Str remain))
      line := lines ; remain := ""
    program append addressof:(new Str "    "+line)
    lines := remain
  var Link:Module module :> new Module
  module name := "clustering formula"
  module include the_module:"/pliant/language/basic/safe.pli"
  module include the_module:"/pliant/storage/database/prototype.pli"
  module include the_module:"/pliant/appli/cluster/filter.pli"
  error_push_record (var ErrorRecord e) error_filter_all
  compile_text program module
  if e:id=error_id_noerror
    fun :> (pliant_general_dictionary first name) map Function
    fun:properties insert "text" true addressof:(new Str text)
    pliant_general_dictionary remove name addressof:fun
    formula insert id true addressof:fun
  else
    fun :> null map Function
    err := e message
    e id := error_id_noerror
  error_pull_record e
  pliant_compiler_semaphore release
  sem release

export data_sign file_sign
export cluster_filter