/pliant/storage/database/file.pli
 
 1  abstract 
 2    [Handles datas stored in a file, using HTML like tags.] 
 3   
 4  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 5  # 
 6  # This program is free software; you can redistribute it and/or 
 7  # modify it under the terms of the GNU General Public License version 2 
 8  # as published by the Free Software Foundation. 
 9  # 
 10  # This program is distributed in the hope that it will be useful, 
 11  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 12  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 13  # GNU General Public License for more details. 
 14  # 
 15  # You should have received a copy of the GNU General Public License 
 16  # version 2 along with this program; if not, write to the Free Software 
 17  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 18   
 19  scope "/pliant/storage/" "/pliant/appli/" 
 20  module "/pliant/language/compiler.pli" 
 21  module "/pliant/language/context.pli" 
 22  module "/pliant/language/os.pli" 
 23  module "/pliant/language/stream.pli" 
 24  module "/pliant/language/stream/filesystembase.pli" 
 25  module "/pliant/language/schedule/daemon.pli" 
 26  module "/pliant/admin/file.pli" 
 27  module "prototype.pli" 
 28  module "io.pli" 
 29  module "mount.pli" 
 30  module "login.pli" 
 31  module "/pliant/util/encoding/html.pli" 
 32  module "/pliant/language/data/string_cast.pli" 
 33   
 34  constant auto_store true 
 35  constant auto_store_step 5 
 36  constant verbose false 
 37  constant debug false 
 38  constant compression os_zlib_filename<>"" 
 39   
 40  doc 
 41    [There are two ways to grant that we are the only thread dealing with a given database:] 
 42    list 
 43      item [Either we own the 'sem' sempaphore in read write mode.] 
 44      item [Or we own the 'sem' sempaphore in read only mode, and the 'rdsem' in read write mode.] 
 45   
 46   
 47 
 
 48   
 49   
 50  method t field_offset f -> o 
 51    arg Type t ; arg Str f ; arg Int o 
 52    for (var Int i) t:nb_fields- 
 53      if (field i):name=f 
 54        return (field i):offset 
 55    error error_id_missing "Type "+t:name+" does not have a "+f+" field." 
 56   
 57   
 58 
 
 59   
 60   
 61  public 
 62    type DatabaseFile 
 63      field Database_ common 
 64      field Sem rwsem rdsem 
 65      field Link:DataInterface_ root_interface 
 66      field Str filename 
 67      field Str logname ; field Link:Stream log ; field Link:Str login_tag 
 68      field Intn base_size growth <- 0 
 69      field Int wr_counter <- 0 
 70      field ListNode_ all_node modified_node 
 71   
 72  Database_ maybe DatabaseFile 
 73   
 74   
 75  gvar List_ database_modified_list ; gvar Sem database_modified_sem 
 76  gvar Int database_modified_count := 0 
 77  gvar Int database_handle_count := 0 
 78  gvar Int database_handle_limit := 256 
 79   
 80  method df set_modified 
 81    arg_rw DatabaseFile df 
 82    if df:common:flags:database_modified 
 83      return 
 84    df:common flags += database_modified 
 85    database_modified_sem request 
 86    database_modified_list append df:modified_node 
 87    database_modified_count += 1 
 88    database_modified_sem release 
 89   
 90  method df clear_modified 
 91    arg_rw DatabaseFile df 
 92    if not df:common:flags:database_modified 
 93      return 
 94    df:common flags -= database_modified 
 95    database_modified_sem request 
 96    database_modified_list remove df:modified_node 
 97    database_modified_count -= 1 
 98    database_modified_sem release 
 99   
 100   
 101  gvar List_ database_all_list ; gvar Sem database_all_sem 
 102   
 103  function build df 
 104    arg_w DatabaseFile df 
 105    df:common sem :> df rwsem 
 106    df:common flags := cast DatabaseFlags 
 107    df:common flags += database_autostore 
 108    database_all_sem request 
 109    database_all_list append df:all_node 
 110    database_all_sem release 
 111   
 112  function destroy df 
 113    arg_w DatabaseFile df 
 114    df:common flags += database_loading 
 115    # if pliant_execution_phase>=execution_phase_free 
 116    #   return 
 117    df clear_modified 
 118    database_all_sem request 
 119    database_all_list remove df:all_node 
 120    database_all_sem release 
 121   
 122   
 123  method df get_root d 
 124    arg DatabaseFile df ; arg_w Data_ d 
 125    adr := addressof:df translate DatabaseFile 1 
 126    object := addressof df 
 127    interface :> df root_interface 
 128    base :> df 
 129    path1 :> "" 
 130    path2 :> null map Str 
 131   
 132   
 133  function data_store force 
 134    arg CBool force 
 135    later 
 136   
 137   
 138  method df log_line line 
 139    arg_rw DatabaseFile df ; arg Str line 
 140    plugin log 
 141    df:log writeline line 
 142   
 143  method df log_required -> required 
 144    arg_rw DatabaseFile df ; arg CBool required 
 145    if df:common:flags:database_loading 
 146      return false 
 147    if df:logname:len=0 
 148      return false 
 149    if not df:common:flags:database_modified and df:common:flags:database_autostore 
 150      df set_modified 
 151      if auto_store 
 152        daemon "database autostore daemon" 
 153          while database_modified_count>and not daemon_emergency 
 154            daemon_sleep auto_store_step 
 155            data_store false 
 156    df wr_counter += 1 
 157    if (addressof df:log)=null 
 158      atomic_add database_handle_count 1 
 159      if database_handle_count>database_handle_limit 
 160        daemon "database autoclose daemon" 
 161          data_store false 
 162      df log :> new Stream 
 163      if df:logname=df:filename 
 164        # temporary log 
 165        df:log open df:filename append+linecache+safe 
 166        df:log safe_configure "journal" 
 167      else 
 168        # full log 
 169        var FileInfo info := file_query df:logname standard 
 170        df:log open df:filename append+safe 
 171        df:log safe_configure "journal" 
 172        df:log writeline "<precovery offset=[dq]"+string:(shunt info=defined info:size 0)+"[dq] />" 
 173        df:log close 
 174        df:log open df:logname append+linecache+safe 
 175        df:log safe_configure "journal" 
 176      if df:log=failure 
 177        df log :> null map Stream 
 178        return false 
 179    var Link:Str lt :> data_read_login_tag 
 180    if (addressof df:login_tag)<>addressof:lt 
 181      df log_line lt 
 182      df login_tag :> lt 
 183    required := true 
 184   
 185  method df notify_set d adr type 
 186    arg_rw DatabaseFile df ; arg Data_ d ; arg Address adr ; arg Type type 
 187    plugin notify_set 
 188    if df:log_required 
 189      if type=Str 
 190        df log_line "<pdata path=[dq]"+d:dbpath+"[dq]>"+html_encode:(adr map Str)+"</pdata>" 
 191      else 
 192        var Str value := to_string adr type "raw" 
 193        df log_line "<pdata path=[dq]"+d:dbpath+"[dq]>"+html_encode:value+"</pdata>" 
 194   
 195  method df notify_reset d 
 196    arg_rw DatabaseFile df ; arg Data_ d 
 197    plugin notify_reset 
 198    if df:log_required 
 199      df log_line "<preset path=[dq]"+d:dbpath+"[dq] />" 
 200   
 201  method df notify_create d k 
 202    arg_rw DatabaseFile df ; arg Data_ d ; arg Str k 
 203    plugin notify_create 
 204    if df:log_required 
 205      df log_line "<pcreate path=[dq]"+d:dbpath+"/"+html_encode:k+"[dq] />" 
 206   
 207  method df notify_delete d k 
 208    arg_rw DatabaseFile df ; arg Data_ d ; arg Str k 
 209    plugin notify_delete 
 210    if df:log_required 
 211      df log_line "<pdelete path=[dq]"+d:dbpath+"/"+html_encode:k+"[dq] />" 
 212   
 213   
 214  function copy_lines s d 
 215    arg_rw Stream d 
 216    line_limit := database_line_limit 
 217    while not s:atend 
 218      var Str := readline 
 219      if l<>"<zlib>" 
 220        writeline l 
 221      else 
 222        var Link:Stream :> new Stream 
 223        open "zlib:" "" in+safe pliant_default_file_system s 
 224        copy_lines d 
 225   
 226  function database_recode filename encoding 
 227    arg Str filename encoding 
 228    part copy "recode "+filename 
 229      var Link:Stream old :> new Stream 
 230      old open filename in+safe 
 231      var Link:Stream :> new Stream 
 232      open filename+".tmp" out+safe 
 233      safe_configure "journal" 
 234      var CBool ok 
 235      if encoding="zlib" 
 236        writeline "<zlib>" 
 237        var Link:Stream :> new Stream 
 238        open "zlib:" "" out+safe pliant_default_file_system s 
 239        copy_lines old z 
 240        flush sync 
 241        ok := z:close=success and s:close=success 
 242      else 
 243        copy_lines old s 
 244        flush sync 
 245        ok := s:close=success 
 246      if ok and old:close=success 
 247        file_delete filename 
 248        file_move filename+".tmp" filename 
 249        file_directory_flush filename 
 250      else 
 251        file_delete filename+".tmp" 
 252   
 253   
 254  method df log_recompress 
 255    oarg_rw DatabaseFile df 
 256    if not df:common:flags:database_compressed or df:logname=df:filename or df:logname="" 
 257      return 
 258    var Intn logsize := (file_query df:logname standard) size 
 259    (var Stream s) open df:logname in+safe 
 260    configure "seek "+(string logsize*2\3) 
 261    var CBool binary := false 
 262    for (var Int i) 0 255 
 263      raw_read addressof:(var uInt8 b) 1 
 264      if b>=128 
 265        binary := true 
 266    close 
 267    if binary # most of the log file is already compressed 
 268      return 
 269    database_store_sem rd_request 
 270    database_trace trace "recompressing log file " df:logname 
 271    df:common:sem request "aquire database semaphore (log_recompress) "+df:common:path 
 272    if (exists df:log) 
 273      df:log close 
 274      df log :> null map Stream 
 275      atomic_add database_handle_count -1 
 276    database_recode df:logname "zlib" 
 277    df base_size := (file_query df:logname standard) size 
 278    df:common:sem release 
 279    database_store_sem rd_release 
 280   
 281  method df store -> status 
 282    oarg_rw DatabaseFile df ; arg Status status 
 283    df:sem rd_request "aquire database semaphore (store) "+df:common:path 
 284    df:rdsem request "aquire database io semaphore (store) "+df:common:path 
 285    if df:common:flags:database_modified 
 286      if (exists df:log) 
 287        df:log close 
 288        df log :> null map Stream 
 289        atomic_add database_handle_count -1 
 290      status := df do_store df:filename 
 291      df base_size := (file_query df:logname standard) size 
 292      if status=success 
 293        df clear_modified 
 294    else 
 295      status := success 
 296    df:rdsem release 
 297    df:sem rd_release 
 298   
 299   
 300  method df setup filename logname mountpoint 
 301    oarg_rw DatabaseFile df ; arg Str filename logname mountpoint 
 302    df:sem request "aquire database semaphore (setup) "+df:common:path 
 303    df filename := filename 
 304    df logname := logname 
 305    df path := mountpoint # setting the path before loading is required when slit field are used in order to get the full path in slitted database 
 306    df do_load filename df:base_size 
 307    if mountpoint<>"" 
 308      data_mount df mountpoint 
 309    if df:base_size=undefined 
 310      df base_size := (file_query df:logname standard) size 
 311    eif df:common:flags:database_autostore 
 312      df set_modified   
 313    df:sem release 
 314   
 315   
 316  gvar Array:Int hour_stats # per hours statistics about activity 
 317  function init_hour_stats 
 318    hour_stats size := 24 
 319    for (var Int i) 0 23 
 320      hour_stats := 0 
 321  init_hour_stats 
 322  gvar Int hour_current := 0 
 323  gvar Int hour_wr_counter := 0 
 324  gvar Int hour_best := 0 
 325  gvar Sem hour_sem 
 326   
 327  function hour_load h -> l 
 328    arg Int h ; arg Int l 
 329    := (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) 
 330   
 331  function data_store force 
 332    arg CBool force 
 333    var CBool hour_force := false 
 334    var DateTime now := datetime 
 335    hour_sem request 
 336    if now:hour<>hour_current 
 337      hour_stats hour_current := hour_wr_counter 
 338      hour_current := now hour ; hour_wr_counter := 0 
 339      if hour_current=0 
 340        hour_best := 0 
 341        for (var Int i) 1 23 
 342          if hour_load:i<hour_load:hour_best 
 343            hour_best := i 
 344      if hour_current=hour_best or hour_load:hour_current=0 
 345        hour_force := true 
 346    hour_sem release 
 347    var List l 
 348    database_modified_sem rd_request 
 349    var Pointer:ListNode_ :> database_modified_list first 
 350    while exists:n 
 351      constant modified_node_offset (DatabaseFile field_offset "modified_node") 
 352      var Link:DatabaseFile df :> (addressof:translate Byte -modified_node_offset) map DatabaseFile 
 353      if (df:sem nowait_request) 
 354        hour_sem request 
 355        hour_wr_counter += df wr_counter 
 356        df wr_counter := 0 
 357        hour_sem release 
 358        df:sem release 
 359      var Intn size := (file_query df:logname standard) size 
 360      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) 
 361        if df:filename<>"" 
 362          append addressof:df 
 363      :> next 
 364    database_modified_sem rd_release 
 365    var Pointer:Arrow :> first 
 366    while c<>null 
 367      var Link:DatabaseFile df :> omap DatabaseFile 
 368      database_trace trace "auto-store " df:filename 
 369      if df:store=success 
 370        df log_recompress 
 371      :> next c 
 372   
 373  function data_store 
 374    data_store true 
 375   
 376   
 377  method df query command -> answer 
 378    oarg DatabaseFile df ; arg Str command answer 
 379    answer := shunt command="filename" df:filename command="logname" df:logname command="modified" (shunt df:common:flags:database_modified "true" "false""" 
 380   
 381  method df configure command -> status 
 382    oarg_rw DatabaseFile df ; arg Str command ; arg Status status 
 383    if compression and command="encoding zlib" 
 384      if not df:common:flags:database_compressed 
 385        database_trace trace "compress " df:filename 
 386        df:sem request "aquire database semaphore (configure) "+df:common:path 
 387        df:common flags += database_compressed 
 388        status := df do_store df:filename 
 389        df base_size := (file_query df:logname standard) size 
 390        if df:logname<>"" and df:logname<>df:filename and status=success 
 391          database_recode df:logname "zlib" 
 392        df:sem release 
 393      else 
 394        status := success 
 395    eif command="encoding clear" 
 396      if df:common:flags:database_compressed 
 397        database_trace trace "uncompress " df:filename 
 398        df:sem request "aquire database semaphore (configure) "+df:common:path 
 399        df:common flags -= database_compressed 
 400        status := df do_store df:filename 
 401        df base_size := (file_query df:logname standard) size 
 402        if df:logname<>"" and df:logname<>df:filename and status=success 
 403          database_recode df:logname "clear" 
 404        df:sem release 
 405      else 
 406        status := success 
 407    eif (command parse "growth" df:growth) 
 408      status := success 
 409    eif command="close auto" 
 410      df:sem request "aquire database semaphore (configure) "+df:common:path 
 411      df:common flags += database_autoclose 
 412      df:sem release 
 413      status := success 
 414    eif command="close manual" 
 415      df:sem request "aquire database semaphore (configure) "+df:common:path 
 416      df:common flags -= database_autoclose 
 417      df:sem release 
 418      status := success 
 419    eif command="store auto" 
 420      df:sem request "aquire database semaphore (configure) "+df:common:path 
 421      df:common flags += database_autostore 
 422      df:sem release 
 423      status := success 
 424    eif command="store manual" 
 425      df:sem request "aquire database semaphore (configure) "+df:common:path 
 426      df:common flags -= database_autostore 
 427      df:sem release 
 428      status := success 
 429    else 
 430      status := failure 
 431   
 432   
 433  function data_file_switch src dest -> status 
 434    arg Str src dest ; arg Status status 
 435    status := failure 
 436    database_all_sem rd_request 
 437    var Pointer:ListNode_ :> database_all_list first 
 438    while exists:n 
 439      constant all_node_offset (DatabaseFile field_offset "all_node") 
 440      var Link:DatabaseFile df :> (addressof:translate Byte -all_node_offset) map DatabaseFile 
 441      if df:filename=dest or (file_os_name df:filename)=file_os_name:dest and file_os_name:dest<>"" 
 442        df:sem request "aquire database semaphore (data_file_switch) "+df:common:path 
 443        file_move src dest 
 444        file_directory_flush dest 
 445        df do_load df:filename 
 446        df clear_modified 
 447        df:sem release 
 448        status := success 
 449      :> next 
 450    database_all_sem rd_release 
 451   
 452  export data_file_switch 
 453   
 454   
 455  function load_databases parameter filehandle 
 456    arg Address parameter ; arg Int filehandle 
 457    var Pointer:ListNode_ :> database_all_list first 
 458    while exists:n 
 459      constant all_node_offset (DatabaseFile field_offset "all_node") 
 460      var Link:DatabaseFile df :> (addressof:translate Byte -all_node_offset) map DatabaseFile 
 461      df do_load df:filename 
 462      df clear_modified 
 463      :> next 
 464  gvar DelayedAction da0 
 465  da0 function :> the_function load_databases Address Int 
 466  pliant_restore_actions append addressof:da0 
 467   
 468   
 469  export '. setup' '. store' 
 470  export data_store database_recode 
 471  export database_handle_limit 
 472   
 473   
 474