Adding transactions further - settled on MVCC
[dbsrgits/DBM-Deep.git] / lib / DBM / Deep / File.pm
CommitLineData
460b1067 1package DBM::Deep::File;
2
3use 5.6.0;
4
5use strict;
6use warnings;
7
8use Fcntl qw( :DEFAULT :flock :seek );
9
10our $VERSION = '0.01';
11
12sub new {
13 my $class = shift;
14 my ($args) = @_;
15
16 my $self = bless {
17 autobless => undef,
18 autoflush => undef,
19 end => 0,
20 fh => undef,
21 file => undef,
22 file_offset => 0,
23 locking => undef,
24 locked => 0,
25 filter_store_key => undef,
26 filter_store_value => undef,
27 filter_fetch_key => undef,
28 filter_fetch_value => undef,
28394a1a 29
30 transaction_id => 0,
15ba72cc 31 transaction_offset => 0,
460b1067 32 }, $class;
33
34 # Grab the parameters we want to use
35 foreach my $param ( keys %$self ) {
36 next unless exists $args->{$param};
37 $self->{$param} = $args->{$param};
38 }
39
40 if ( $self->{fh} && !$self->{file_offset} ) {
41 $self->{file_offset} = tell( $self->{fh} );
42 }
43
44 $self->open unless $self->{fh};
45
46 return $self;
47}
48
49sub open {
50 my $self = shift;
51
52 # Adding O_BINARY does remove the need for the binmode below. However,
53 # I'm not going to remove it because I don't have the Win32 chops to be
54 # absolutely certain everything will be ok.
55 my $flags = O_RDWR | O_CREAT | O_BINARY;
56
57 my $fh;
58 sysopen( $fh, $self->{file}, $flags )
59 or die "DBM::Deep: Cannot sysopen file '$self->{file}': $!\n";
60 $self->{fh} = $fh;
61
62 # Even though we use O_BINARY, better be safe than sorry.
63 binmode $fh;
64
65 if ($self->{autoflush}) {
66 my $old = select $fh;
67 $|=1;
68 select $old;
69 }
70
71 return 1;
72}
73
74sub close {
75 my $self = shift;
76
77 if ( $self->{fh} ) {
78 close $self->{fh};
79 $self->{fh} = undef;
80 }
81
82 return 1;
83}
84
85sub DESTROY {
86 my $self = shift;
87 return unless $self;
88
89 $self->close;
90
91 return;
92}
93
15ba72cc 94##
95# If db locking is set, flock() the db file. If called multiple
96# times before unlock(), then the same number of unlocks() must
97# be called before the lock is released.
98##
99sub lock {
100 my $self = shift;
101 my ($obj, $type) = @_;
102 $type = LOCK_EX unless defined $type;
103
104 if (!defined($self->{fh})) { return; }
105
106 if ($self->{locking}) {
107 if (!$self->{locked}) {
108 flock($self->{fh}, $type);
109
110 # refresh end counter in case file has changed size
111 my @stats = stat($self->{fh});
112 $self->{end} = $stats[7];
113
114 # double-check file inode, in case another process
115 # has optimize()d our file while we were waiting.
116 if ($stats[1] != $self->{inode}) {
117 $self->close;
118 $self->open;
119
120 #XXX This needs work
121 $obj->{engine}->setup_fh( $obj );
122
123 flock($self->{fh}, $type); # re-lock
124
125 # This may not be necessary after re-opening
126 $self->{end} = (stat($self->{fh}))[7]; # re-end
127 }
128 }
129 $self->{locked}++;
130
131 return 1;
132 }
133
134 return;
135}
136
137##
138# If db locking is set, unlock the db file. See note in lock()
139# regarding calling lock() multiple times.
140##
141sub unlock {
142 my $self = shift;
143
144 if (!defined($self->{fh})) { return; }
145
146 if ($self->{locking} && $self->{locked} > 0) {
147 $self->{locked}--;
148 if (!$self->{locked}) { flock($self->{fh}, LOCK_UN); }
149
150 return 1;
151 }
152
153 return;
154}
155
156sub set_transaction_offset {
157 my $self = shift;
158 $self->{transaction_offset} = shift;
159}
160
28394a1a 161sub begin_transaction {
162 my $self = shift;
163
15ba72cc 164 my $fh = $self->{fh};
165
166 seek( $fh, $self->{transaction_offset}, SEEK_SET );
167
28394a1a 168 $self->{transaction_id}++;
169}
170
171sub end_transaction {
172 my $self = shift;
173
15ba72cc 174# seek( $fh, $self->{transaction_offset}, SEEK_SET );
175
28394a1a 176 $self->{transaction_id} = 0;
177}
178
179sub transaction_id {
180 my $self = shift;
181
182 return $self->{transaction_id};
183}
184
185#sub commit {
186#}
187
460b1067 1881;
189__END__
190