1#!/usr/bin/perl 2# 3# $Header: /Users/claude/fuzz/lib/Genezzo/BufCa/RCS/BufCaElt.pm,v 7.7 2006/10/20 18:52:16 claude Exp claude $ 4# 5# copyright (c) 2003,2004,2005,2006 Jeffrey I Cohen, all rights reserved, worldwide 6# 7# 8use strict; 9use warnings; 10 11package Genezzo::BufCa::BufCaElt; 12 13use Genezzo::Util; 14use Carp; 15use warnings::register; 16 17use Genezzo::BufCa::DirtyScalar; 18 19BEGIN { 20 use Exporter (); 21 our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); 22 23 # set the version for version checking 24# $VERSION = 1.00; 25 # if using RCS/CVS, this may be preferred 26 $VERSION = do { my @r = (q$Revision: 7.7 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker 27 28 @ISA = qw(Exporter); 29# @EXPORT = qw(&func1 &func2 &func4 &func5); 30 @EXPORT = ( ); 31 %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], 32 33 # your exported package globals go here, 34 # as well as any optionally exported functions 35# @EXPORT_OK = qw($Var1 %Hashit &func3 &func5); 36 @EXPORT_OK = ( ); 37 38} 39 40our @EXPORT_OK; 41 42# non-exported package globals go here 43 44 45# initialize package globals, first exported ones 46#my $Var1 = ''; 47#my %Hashit = (); 48 49# then the others (which are still accessible as $Some::Module::stuff) 50#$stuff = ''; 51#@more = (); 52 53# all file-scoped lexicals must be created before 54# the functions below that use them. 55 56# file-private lexicals go here 57#my $priv_var = ''; 58#my %secret_hash = (); 59# here's a file-private function as a closure, 60# callable as &$priv_func; it cannot be prototyped. 61#my $priv_func = sub { 62 # stuff goes here. 63#}; 64 65# make all your functions, whether exported or not; 66# remember to put something interesting in the {} stubs 67#sub func1 {print "hi";} # no prototype 68#sub func2() {} # proto'd void 69#sub func3($$) {} # proto'd to 2 scalars 70#sub func5 {print "ho";} # no prototype 71 72sub _init 73{ 74 #whoami; 75 #greet @_; 76 my $self = shift; 77 78 my %required = ( 79 blocksize => "no blocksize !" 80 ); 81 82 my %args = ( 83 @_); 84 85 return 0 86 unless (Validate(\%args, \%required)); 87 88 # XXX: a bit redundant to keep blocksize for each bce - should be 89 # constant for entire cache... 90 $self->{blocksize} = $args{blocksize}; 91 92 my $buf; 93 $self->{tbuf} = tie $buf, "Genezzo::BufCa::DirtyScalar"; 94 95 $buf = "\0" x $self->{blocksize}; 96 $self->{bigbuf} = \$buf; 97 98 $self->{info} = {}; # DEPRECATE: switch to Contrib 99 100 # Contrib is the counterpart to the CPAN Genezzo::Contrib 101 # namespace. Add hash keys according to your package name, e.g. 102 # $self->{Contrib}->{Clustered} = 'foo' 103 # for Genezzo::Contrib::Clustered 104 $self->{Contrib} = {}; # UNUSED until "info" is removed 105 106 $self->{pin} = 0; 107 $self->{dirty} = 0; 108 109 $self->{file_read} = 0; 110 111 return 1; 112} 113 114sub new 115{ 116 my $invocant = shift; 117 my $class = ref($invocant) || $invocant ; 118 my $self = { }; 119 120 my %args = (@_); 121 122 return undef 123 unless (_init($self,%args)); 124 125 my $foo = bless $self, $class; 126 $self->_postinit(); 127 return $foo; 128 129} # end new 130 131sub _postinit 132{ 133 my $self = shift; 134 135 # supply a closure so the bce is marked dirty 136 # if the underlying tied buffer gets overwritten 137 my $foo = sub { $self->_dirty(1); }; 138 $self->{tbuf}->_StoreCB($foo); 139 $self->{tbuf}->SetBCE($self); # DEPRECATE 140 141} 142 143sub _pin 144{ 145# XXX: need atomic increment/decrement 146 147 my $self = shift; 148 149 if (scalar(@_)) 150 { 151 my $pin_inc = shift; 152# whisper "pinning $pin_inc -> "; 153 $self->{pin} += $pin_inc; 154 } 155 156 # XXX XXX XXX XXX: pin > 1 possible -- block zero (file header) 157 # gets pinned multiple times 158 159# whisper "current pin val: ", $self->{pin}; 160 return $self->{pin}; 161 162} 163 164sub _dirty 165{ 166 my $self = shift; 167 $self->{dirty} = shift if @_ ; 168 169 # HOOK: 170 # use sys_hook to define 171 if (defined(&_BCE_dirtyhook)) 172 { 173 _BCE_dirtyhook($self, @_); 174 } 175 176 return $self->{dirty}; 177 178} 179 180sub _fileread 181{ 182 my $self = shift; 183 $self->{file_read} = shift if @_ ; 184 185 return $self->{file_read}; 186 187} 188 189# DEPRECATE 190sub GetInfo 191{ 192 my $self = shift; 193 return $self->{info}; 194} 195 196sub GetContrib 197{ 198 my $self = shift; 199 return $self->{info}; 200} 201 202sub RSVP 203{ 204 my $self = shift; 205 206# print "foo\n"; 207 208 my %args = @_; 209 210 unless (exists($args{name}) && 211 exists($args{value})) 212 { 213 return undef; 214 } 215 216# greet $args{name}; 217# print $args{name},"\n"; 218 219 unless (exists($self->{info}->{mailbox})) 220 { 221 $self->{info}->{mailbox} = {}; 222 } 223 224 $self->{info}->{mailbox}->{$args{name}} = $args{value}; 225 226# whoami; 227 228 return $self->{info}; 229} 230 231 232END { } # module clean-up code here (global destructor) 233 234## YOUR CODE GOES HERE 235 236 2371; # don't forget to return a true value from the file 238 239__END__ 240# Below is stub documentation for your module. You better edit it! 241 242=head1 NAME 243 244Genezzo::BufCa::BufCaElt - Buffer Cache Element 245 246=head1 SYNOPSIS 247 248=head1 DESCRIPTION 249 250A Buffer Cache Element contains an actual datablock plus some minimal 251state information: the blocksize, whether the block is in use, and 252whether the contents have been modified. BufCaElt clients can use 253GetInfo() to store and retrieve a hash of arbitrary information for 254each block. 255 256=head1 ARGUMENTS 257 258=head1 FUNCTIONS 259 260=over 4 261 262=item GetInfo - return a reference to the info hash. BCFile uses 263 this hash to store the filenum/blocknum info associated with 264 the current BufCaElt. 265 266=item GetContrib - return a reference to the info hash. BCFile uses 267 this hash to store the filenum/blocknum info associated with 268 the current BufCaElt. 269 270=item _dirty - set/clear the "dirty" bit. Used to indicate if buffer 271 has been modified. 272 273=item _postinit - Pass a callback to the DirtyScalar tie so the "dirty" bit 274 gets set automatically whenever the buffer is modified. Also, 275 pass a reference to $self so DirtyScalar can use GetInfo to find 276 the current filenum/blocknum and any other interesting information. 277 278=item _pin - used to pin/unpin a block in the cache via the PinScalar tie. 279 Blocks that are actively referenced must remain "pinned" in the 280 buffer cache, but unreferenced blocks can be freed. If they are 281 "dirty", the modified buffer must be written to disk, else the 282 BufCaElt can simply be re-used. 283 284=back 285 286=head2 EXPORT 287 288=head1 LIMITATIONS 289 290various 291 292=head1 TODO 293 294=over 4 295 296=item Deprecate GetInfo, convert to GetContrib. 297 298=item Switch syshook methods to use _BCE_dirtyhook 299 300=item get fileno, blockno info 301 302=item deal with multiple pins on same block sanely. We shouldn't be 303 maintaining a reference count scheme here. Shouldn't pin be <= 1, 304 and the destroy cb should set it to zero when last reference is 305 garbage collected? 306 307=back 308 309=head1 AUTHOR 310 311Jeffrey I. Cohen, jcohen@genezzo.com 312 313=head1 SEE ALSO 314 315L<perl(1)>. 316 317Copyright (c) 2003, 2004, 2005, 2006 Jeffrey I Cohen. All rights reserved. 318 319 This program is free software; you can redistribute it and/or modify 320 it under the terms of the GNU General Public License as published by 321 the Free Software Foundation; either version 2 of the License, or 322 any later version. 323 324 This program is distributed in the hope that it will be useful, 325 but WITHOUT ANY WARRANTY; without even the implied warranty of 326 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 327 GNU General Public License for more details. 328 329 You should have received a copy of the GNU General Public License 330 along with this program; if not, write to the Free Software 331 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 332 333Address bug reports and comments to: jcohen@genezzo.com 334 335For more information, please visit the Genezzo homepage 336at L<http://www.genezzo.com> 337 338=cut 339