1# tie_growfile.tcl -- 2# 3# Data source: Files. 4# 5# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> 6# 7# See the file "license.terms" for information on usage and redistribution 8# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 9# 10# RCS: @(#) $Id: tie_growfile.tcl,v 1.1 2006/03/08 04:55:58 andreas_kupries Exp $ 11 12# ### ### ### ######### ######### ######### 13## Requisites 14 15package require snit 16package require tie 17 18# ### ### ### ######### ######### ######### 19## Implementation 20 21snit::type ::tie::std::growfile { 22 # ### ### ### ######### ######### ######### 23 ## Notes 24 25 ## This data source is geared towards the storage of arrays which 26 ## will never shrink over time. Data is always appended to the 27 ## files associated with this driver. Nothing is ever 28 ## removed. Compaction does not happen either, so modification of 29 ## array entries will keep the old information around in the history. 30 31 # ### ### ### ######### ######### ######### 32 ## Specials 33 34 pragma -hastypemethods no 35 pragma -hasinfo no 36 pragma -simpledispatch yes 37 38 # ### ### ### ######### ######### ######### 39 ## API : Construction & Destruction 40 41 constructor {thepath} { 42 # Locate and open the journal file. 43 44 set path [file normalize $thepath] 45 if {[file exists $path]} { 46 set chan [open $path {RDWR EXCL APPEND}] 47 } else { 48 set chan [open $path {RDWR EXCL CREAT APPEND}] 49 } 50 fconfigure $chan -buffering none -encoding utf-8 51 return 52 } 53 54 destructor { 55 # Release the channel to the journal file, should it be open. 56 if {$chan ne ""} {close $chan} 57 return 58 } 59 60 # ### ### ### ######### ######### ######### 61 ## API : Data source methods 62 63 method get {} { 64 if {![file size $path]} {return {}} 65 $self LoadJournal 66 return [array get cache] 67 } 68 69 method names {} { 70 if {![file size $path]} {return {}} 71 $self LoadJournal 72 return [array names cache] 73 } 74 75 method size {} { 76 if {![file size $path]} {return 0} 77 $self LoadJournal 78 return [array size cache] 79 } 80 81 method getv {index} { 82 if {![file size $path]} { 83 return -code error "can't read \"$index\": no such variable" 84 } 85 $self LoadJournal 86 return $cache($index) 87 } 88 89 method set {dict} { 90 puts -nonewline $chan $dict 91 puts -nonewline $chan { } 92 flush $chan 93 return 94 } 95 96 method setv {index value} { 97 puts -nonewline $chan [list $index $value] 98 puts -nonewline $chan { } 99 flush $chan 100 return 101 } 102 103 method unset {{pattern *}} { 104 return -code error \ 105 "Deletion of entries is not allowed by this data source" 106 } 107 108 method unsetv {index} { 109 return -code error \ 110 "Deletion of entries is not allowed by this data source" 111 } 112 113 # ### ### ### ######### ######### ######### 114 ## Internal : Instance data 115 116 variable chan {} ; # Channel to write the journal. 117 variable path {} ; # Path to journal file. 118 119 # Journal loading, and cache. 120 121 variable count 0 ; # #Operations in the journal. 122 variable cvalid 0 ; # Validity of the cache. 123 variable cache -array {} ; # Cache for journal 124 125 # Management of the cache: See notes at beginning. 126 127 # ### ### ### ######### ######### ######### 128 ## Internal: Loading from the journal. 129 130 method LoadJournal {} { 131 if {$cvalid} return 132 set cvalid 1 133 134 set in [open $path r] 135 array set cache [read $in] 136 close $in 137 return 138 } 139 140 # ### ### ### ######### ######### ######### 141} 142 143# ### ### ### ######### ######### ######### 144## Ready to go 145 146::tie::register ::tie::std::growfile as growfile 147package provide tie::std::growfile 1.0 148