1#!/usr/bin/perl 2# 3# $Header: /Users/claude/fuzz/lib/Genezzo/BufCa/RCS/BufCa.pm,v 7.3 2006/08/02 06:01:21 claude Exp claude $ 4# 5# copyright (c) 2003, 2004 Jeffrey I Cohen, all rights reserved, worldwide 6# 7# 8use strict; 9use warnings; 10 11package Genezzo::BufCa::BufCa; 12 13use Genezzo::BufCa::PinScalar; 14use Genezzo::BufCa::BufCaElt; 15use Genezzo::Util; 16use Carp; 17use warnings::register; 18 19 20BEGIN { 21 use Exporter (); 22 our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); 23 24 # set the version for version checking 25# $VERSION = 1.00; 26 # if using RCS/CVS, this may be preferred 27 $VERSION = do { my @r = (q$Revision: 7.3 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker 28 29 @ISA = qw(Exporter); 30# @EXPORT = qw(&func1 &func2 &func4 &func5); 31 @EXPORT = ( ); 32 %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], 33 34 # your exported package globals go here, 35 # as well as any optionally exported functions 36# @EXPORT_OK = qw($Var1 %Hashit &func3 &func5); 37 @EXPORT_OK = ( ); 38 39} 40 41our @EXPORT_OK; 42 43# non-exported package globals go here 44 45 46# initialize package globals, first exported ones 47#my $Var1 = ''; 48#my %Hashit = (); 49 50# then the others (which are still accessible as $Some::Module::stuff) 51#$stuff = ''; 52#@more = (); 53 54# all file-scoped lexicals must be created before 55# the functions below that use them. 56 57# file-private lexicals go here 58#my $priv_var = ''; 59#my %secret_hash = (); 60# here's a file-private function as a closure, 61# callable as &$priv_func; it cannot be prototyped. 62#my $priv_func = sub { 63 # stuff goes here. 64#}; 65 66# make all your functions, whether exported or not; 67# remember to put something interesting in the {} stubs 68#sub func1 {print "hi";} # no prototype 69#sub func2() {} # proto'd void 70#sub func3($$) {} # proto'd to 2 scalars 71#sub func5 {print "ho";} # no prototype 72 73sub _init 74{ 75 #whoami; 76 my $self = shift; 77# greet @_; 78 79 my %required = ( 80 blocksize => "no blocksize !" 81 ); 82 83 my %args = ( 84 numblocks => 10, 85 @_); 86 87 return 0 88 unless (Validate(\%args, \%required)); 89 90 return 0 91 unless (NumVal( 92 verbose => warnings::enabled(), 93 name => "blocksize", 94 val => $args{blocksize}, 95 MIN => 1)); 96 97 return 0 98 unless (NumVal( 99 verbose => warnings::enabled(), 100 name => "numblocks", 101 val => $args{numblocks}, 102 MIN => 1)); 103 104 $self->{blocksize} = $args{blocksize}; 105 106 $self->{bce_arr} = []; 107 108 for (my $i = 0; $i < $args{numblocks}; $i++) 109 { 110 my $bce = Genezzo::BufCa::BufCaElt->new(blocksize => $args{blocksize}); 111 112 unless (defined($bce)) 113 { 114 carp "failed to allocate Buffer Cache Element $i" 115 if warnings::enabled(); 116 return 0; 117 } 118 119 push (@{$self->{bce_arr}}, $bce); 120 121 } 122 123 # keep track of virgin (never used) buffers to speed GetFree 124 # allocation. degenerate to linear search after all buffers used 125 # once. 126 # XXX: after bcfile flush bufs may still be pinned so cannot reset 127 $self->{virgin} = [0, $args{numblocks} - 1]; 128 129 return 1; 130} 131 132sub new 133{ 134 my $invocant = shift; 135 my $class = ref($invocant) || $invocant ; 136 my $self = { }; 137 138 my %args = (@_); 139 140 return undef 141 unless (_init($self,%args)); 142 143 return bless $self, $class; 144 145} # end new 146 147sub Dump 148{ 149 whoami; 150 my $self = shift; 151 152 my %hashi = (blocksize => $self->{blocksize}, 153 numblocks => scalar(@{$self->{bce_arr}}), 154 unused => $self->{virgin} 155 ); 156 157 return \%hashi; 158} 159 160sub Resize 161{ 162 whoami; 163 my $self = shift; 164 165 my $newsize = shift; 166 167 if ($newsize > scalar(@{$self->{bce_arr}})) 168 { 169 my $i = scalar(@{$self->{bce_arr}}); 170 171 for (; $i < $newsize; $i++) 172 { 173 my $bce = Genezzo::BufCa::BufCaElt->new(blocksize => 174 $self->{blocksize}); 175 176 unless (defined($bce)) 177 { 178 carp "failed to allocate Buffer Cache Element $i" 179 if warnings::enabled(); 180 last; 181 } 182 push (@{$self->{bce_arr}}, $bce); 183 } 184 } 185 186 if ($newsize < scalar(@{$self->{bce_arr}})) 187 { 188 my $i = scalar(@{$self->{bce_arr}}); 189 190 $i--; 191 192 for (; $i >= $newsize; $i--) 193 { 194 my $bce = $self->{bce_arr}->[$i]; 195 196# greet $bce; 197 198 # XXX: must be able to lock exclusive here... 199 unless (defined($bce) && (!$bce->_pin())) 200 { 201 carp "failed to pin Buffer Cache Element $i" 202 if warnings::enabled(); 203 last; 204 } 205 206 pop (@{$self->{bce_arr}}); 207 } 208 } 209 $self->{virgin}->[1] = scalar(@{$self->{bce_arr}}); 210 211 return scalar(@{$self->{bce_arr}}); 212} 213 214 215sub ReadBlock 216{ 217 my $self = shift; 218 219 my %required = ( 220 blocknum => "no blocknum !" 221 ); 222 223 my %args = ( 224 @_); 225 226 return undef 227 unless (Validate(\%args, \%required)); 228 229 my $bnum = $args{blocknum}; 230 my $maxrang = scalar(@{$self->{bce_arr}}); 231 232 return undef 233 unless (NumVal( 234 verbose => warnings::enabled(), 235 name => "Buffer Cache Element", 236 val => $bnum, 237 MIN => 0, 238 MAX => $maxrang)); 239 # XXX: do exists check? 240# return $self->{bce_arr}->[$bnum]; 241 my $bce; 242 my $tie_bce = tie $bce, "Genezzo::BufCa::PinScalar"; 243 244 $bce = $self->{bce_arr}->[$bnum]; 245 $bce->_pin(1); 246 247 # NB: construct a closure to unpin a bce when its reference 248 # is destroyed 249 my $unpin_closure = sub { 250 my $self = shift; 251# greet $self; 252# whisper "creator: $self->{package}, "; 253# whisper "$self->{filename}, $self->{lineno} - unpin \n"; 254 unless (defined($self)) 255 { 256 whisper "self already destroyed"; 257 return; 258 } 259 my $dee_ref = ${ $self->{ref} }; 260 unless (defined($dee_ref)) 261 { 262 whisper "self->ref already destroyed"; 263 return; 264 } 265 266 $dee_ref->_pin(-1); 267 }; # end unpin_closure sub 268 269 $tie_bce->_DestroyCB($unpin_closure); 270 271 return \$bce; 272 273} # end ReadBlock 274 275sub _dcb { 276 my $self = shift; 277 greet $self; 278 print "creator: $self->{package}, "; 279 print "$self->{filename}, $self->{lineno} - unpin \n"; 280 my $dee_ref = ${ $self->{ref} }; 281 $dee_ref->_pin(-1); 282} 283 284sub GetFree 285{ 286 287 # XXX: free blocks must be exclusive locked, then downgraded to 288 # share. 289 290 my $self = shift; 291 my @outi; 292 293 my $i = 0; 294 my $unuse_check = 0; 295 296 if (exists($self->{virgin})) 297 { 298 $unuse_check = ($self->{virgin}->[0] < $self->{virgin}->[1]); 299 if ($unuse_check) 300 { 301 $i = $self->{virgin}->[0]; 302 $self->{virgin}->[0]++; 303 } 304 else 305 { 306# whisper "all blocks used -- search for a free one"; 307 } 308 } 309 310 L_for1: 311 while ($i < scalar(@{$self->{bce_arr}})) 312 { 313 my $bce = $self->{bce_arr}->[$i]; 314 # XXX: must be able to lock exclusive here... 315 unless ($bce->_pin()) 316 { 317 push @outi, $i; 318# whisper "got block $i ! \n"; 319 push @outi, ($self->ReadBlock(blocknum => $i)); 320 return \@outi; 321 } 322 323 if ($unuse_check) 324 { 325 # if "unused" block was pinned just search from beginning 326 $unuse_check = 0; 327 $i = 0; 328 next; 329 } 330 331 $i++; 332 } 333 return \@outi; 334 335} # end getfree 336 337# XXX: don't write back blocks for array implementation of buffer cache 338sub WriteBlock 339{ 340 my $self = shift; 341 342 if (0) 343 { 344# my $fh = shift @_; 345# my $blknum = shift @_; 346# my $refbuf = shift @_; 347# 348# sysseek ($fh, ($blknum * $Genezzo::Util::DEFBLOCKSIZE), 0 ) 349# or die "bad seek - block $blknum : $! \n"; 350# 351# gnz_write ($fh, $$refbuf, $Genezzo::Util::DEFBLOCKSIZE ) 352# == $Genezzo::Util::DEFBLOCKSIZE 353# or die "bad write - block $blknum : $! \n"; 354 } 355 356 return 1; 357 358} # end WriteBlock 359 360sub DESTROY 361{ 362 my $self = shift; 363# whoami; 364 365 if (exists($self->{bce_arr})) 366 { 367 while (scalar(@{$self->{bce_arr}})) 368 { 369 shift (@{$self->{bce_arr}}) ; 370 } 371 } 372 373} 374 375END { } # module clean-up code here (global destructor) 376 377## YOUR CODE GOES HERE 378 3791; # don't forget to return a true value from the file 380 381__END__ 382# Below is stub documentation for your module. You better edit it! 383 384=head1 NAME 385 386 Genezzo::BufCa::BufCa.pm - A simple in-memory buffer cache for a 387 single process, without locking. 388 389=head1 SYNOPSIS 390 391 use Genezzo::BufCa::BufCa; 392 393 # get a buffer cache 394 my $bc = Genezzo::BufCa::BufCa->new(blocksize => 10, numblocks => 5); 395 396 # find a free block 397 my $free_arr = $bc->GetFree(); 398 399 # get the block number and a reference to a Buffer Cache Element 400 my $blocknum = shift (@{$free_arr}); 401 my $bceref = shift (@{$free_arr}); 402 403 # obtain the actual Buffer Cache Element 404 my $bce = $$bceref; 405 406 # can later use the block number to revisit this Buffer Cache Element 407 . 408 . 409 . 410 # get back the same block 411 $bceref = $bc->ReadBlock(blocknum => $blocknum); 412 $bce = $$bceref; 413 414=head1 DESCRIPTION 415 416 The in-memory buffer cache is a simple module designed to form the 417 basis of a more complicated, file-based, multi-process buffer cache 418 with locking. The buffer cache contains a number of Buffer Cache 419 Elements (BCEs), a special wrapper class for simple byte buffers 420 (blocks). The BCE has two callback functions or closures of note: 421 422=over 4 423 424=item pin 425 426 A block is pinned as long as the bceref (returned via GetFree or 427 ReadBlock) is in scope. BufCa uses a scalar tie class to unpin the 428 block when the bceref is garbage collected. The basic pin function 429 acts as a form of advisory locking, and could be upgraded to a true 430 locking mechanism. 431 432=item dirty 433 434 a block is marked as dirty if it is modified. 435 436=back 437 438=head1 FUNCTIONS 439 440=over 4 441 442=item new 443 444 Takes arguments blocksize (required, in bytes), numblocks (10 by 445 default). Returns a new buffer cache of the specified number of 446 blocks of size blocksize. 447 448=item GetFree 449 450 Returns an array @free = (block number, bceref). The bceref and its 451 associated blocknumber are for a block that is currently not in use. 452 Note that the block might be dirty. Also, GetFree is not a space 453 allocator -- it only indicates that a block is not in use. 454 455=item ReadBlock 456 457 Takes argument blocknum, which must be a valid block number. Returns 458 a bceref 459 460=item WriteBlock - unused for in-memory cache 461 462=back 463 464=head2 EXPORT 465 466 None by default. 467 468 469=head1 AUTHOR 470 471 Jeffrey I. Cohen, jcohen@genezzo.com 472 473=head1 SEE ALSO 474 475perl(1). 476 477Copyright (c) 2003, 2004 Jeffrey I Cohen. All rights reserved. 478 479 This program is free software; you can redistribute it and/or modify 480 it under the terms of the GNU General Public License as published by 481 the Free Software Foundation; either version 2 of the License, or 482 any later version. 483 484 This program is distributed in the hope that it will be useful, 485 but WITHOUT ANY WARRANTY; without even the implied warranty of 486 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 487 GNU General Public License for more details. 488 489 You should have received a copy of the GNU General Public License 490 along with this program; if not, write to the Free Software 491 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 492 493Address bug reports and comments to: jcohen@genezzo.com 494 495For more information, please visit the Genezzo homepage 496at L<http://www.genezzo.com> 497 498=cut 499