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