/[fuse_dbi]/trunk/DBI.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /trunk/DBI.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 21 - (show annotations)
Sat Oct 2 15:29:02 2004 UTC (19 years, 5 months ago) by dpavlin
File size: 9514 byte(s)
a lot of changes (0.03 API):
- added unlink (rm) method to invalidate in-memory cache
- added fuse_module_loaded method to check if fuse module is loaded
- fixed short read of last block
- removed Proc::Simple usage and replaced with simplier forking mechanism

This is first working version, but it's not binary-safe yet. NULL bytes
are still problem.


1 #!/usr/bin/perl
2
3 package Fuse::DBI;
4
5 use 5.008;
6 use strict;
7 use warnings;
8
9 use POSIX qw(ENOENT EISDIR EINVAL ENOSYS O_RDWR);
10 use Fuse;
11 use DBI;
12 use Carp;
13 use Data::Dumper;
14
15
16 our $VERSION = '0.03';
17
18 =head1 NAME
19
20 Fuse::DBI - mount your database as filesystem and use it
21
22 =head1 SYNOPSIS
23
24 use Fuse::DBI;
25 Fuse::DBI->mount( ... );
26
27 See L<run> below for examples how to set parametars.
28
29 =head1 DESCRIPTION
30
31 This module will use L<Fuse> module, part of C<FUSE (Filesystem in USErspace)>
32 available at L<http://sourceforge.net/projects/avf> to mount
33 your database as file system.
34
35 That will give you posibility to use normal file-system tools (cat, grep, vi)
36 to manipulate data in database.
37
38 It's actually opposite of Oracle's intention to put everything into database.
39
40
41 =head1 METHODS
42
43 =cut
44
45 =head2 mount
46
47 Mount your database as filesystem.
48
49 my $mnt = Fuse::DBI->mount({
50 filenames => 'select name from files_table as filenames',
51 read => 'sql read',
52 update => 'sql update',
53 dsn => 'DBI:Pg:dbname=webgui',
54 user => 'database_user',
55 password => 'database_password'
56 });
57
58 =cut
59
60 my $dbh;
61 my $sth;
62 my $ctime_start;
63
64 sub read_filenames;
65 sub fuse_module_loaded;
66
67 sub mount {
68 my $class = shift;
69 my $self = {};
70 bless($self, $class);
71
72 my $arg = shift;
73
74 print Dumper($arg);
75
76 carp "mount needs 'dsn' to connect to (e.g. dsn => 'DBI:Pg:dbname=test')" unless ($arg->{'dsn'});
77 carp "mount needs 'mount' as mountpoint" unless ($arg->{'mount'});
78
79 # save (some) arguments in self
80 $self->{$_} = $arg->{$_} foreach (qw(mount));
81
82 foreach (qw(filenames read update)) {
83 carp "mount needs '$_' SQL" unless ($arg->{$_});
84 }
85
86 $ctime_start = time();
87
88 if ($arg->{'fork'}) {
89 my $pid = fork();
90 die "fork() failed: $!" unless defined $pid;
91 # child will return to caller
92 if ($pid) {
93 $self ? return $self : return undef;
94 }
95 }
96
97 $dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, {AutoCommit => 0, RaiseError => 1}) || die $DBI::errstr;
98
99 $sth->{filenames} = $dbh->prepare($arg->{'filenames'}) || die $dbh->errstr();
100
101 $sth->{'read'} = $dbh->prepare($arg->{'read'}) || die $dbh->errstr();
102 $sth->{'update'} = $dbh->prepare($arg->{'update'}) || die $dbh->errstr();
103
104 $self->read_filenames;
105
106 my $mount = Fuse::main(
107 mountpoint=>$arg->{'mount'},
108 getattr=>\&e_getattr,
109 getdir=>\&e_getdir,
110 open=>\&e_open,
111 statfs=>\&e_statfs,
112 read=>\&e_read,
113 write=>\&e_write,
114 utime=>\&e_utime,
115 truncate=>\&e_truncate,
116 unlink=>\&e_unlink,
117 debug=>0,
118 );
119
120 if (! $mount) {
121 warn "mount on ",$arg->{'mount'}," failed!\n";
122 return undef;
123 }
124 };
125
126 =head2 umount
127
128 Unmount your database as filesystem.
129
130 $mnt->umount;
131
132 This will also kill background process which is translating
133 database to filesystem.
134
135 =cut
136
137 sub umount {
138 my $self = shift;
139
140 system "fusermount -u ".$self->{'mount'} || croak "umount error: $!";
141
142 return 1;
143 }
144
145 =head2 fuse_module_loaded
146
147 Checks if C<fuse> module is loaded in kernel.
148
149 die "no fuse module loaded in kernel"
150 unless (Fuse::DBI::fuse_module_loaded);
151
152 This function in called by L<mount>, but might be useful alone also.
153
154 =cut
155
156 sub fuse_module_loaded {
157 my $lsmod = `lsmod`;
158 die "can't start lsmod: $!" unless ($lsmod);
159 if ($lsmod =~ m/fuse/s) {
160 return 1;
161 } else {
162 return 0;
163 }
164 }
165
166 my %files;
167 my %dirs;
168
169 sub read_filenames {
170 my $self = shift;
171
172 # create empty filesystem
173 (%files) = (
174 '.' => {
175 type => 0040,
176 mode => 0755,
177 },
178 # a => {
179 # cont => "File 'a'.\n",
180 # type => 0100,
181 # ctime => time()-2000
182 # },
183 );
184
185 # fetch new filename list from database
186 $sth->{'filenames'}->execute() || die $sth->{'filenames'}->errstr();
187
188 # read them in with sesible defaults
189 while (my $row = $sth->{'filenames'}->fetchrow_hashref() ) {
190 $files{$row->{'filename'}} = {
191 size => $row->{'size'},
192 mode => $row->{'writable'} ? 0644 : 0444,
193 id => $row->{'id'} || 99,
194 };
195
196 my $d;
197 foreach (split(m!/!, $row->{'filename'})) {
198 # first, entry is assumed to be file
199 if ($d) {
200 $files{$d} = {
201 size => $dirs{$d}++,
202 mode => 0755,
203 type => 0040
204 };
205 $files{$d.'/.'} = {
206 mode => 0755,
207 type => 0040
208 };
209 $files{$d.'/..'} = {
210 mode => 0755,
211 type => 0040
212 };
213 }
214 $d .= "/" if ($d);
215 $d .= "$_";
216 }
217 }
218
219 print "found ",scalar(keys %files)-scalar(keys %dirs)," files, ",scalar(keys %dirs), " dirs\n";
220 }
221
222
223 sub filename_fixup {
224 my ($file) = shift;
225 $file =~ s,^/,,;
226 $file = '.' unless length($file);
227 return $file;
228 }
229
230 sub e_getattr {
231 my ($file) = filename_fixup(shift);
232 $file =~ s,^/,,;
233 $file = '.' unless length($file);
234 return -ENOENT() unless exists($files{$file});
235 my ($size) = $files{$file}{size} || 1;
236 my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,1,0,0,1,1024);
237 my ($atime, $ctime, $mtime);
238 $atime = $ctime = $mtime = $files{$file}{ctime} || $ctime_start;
239
240 my ($modes) = (($files{$file}{type} || 0100)<<9) + $files{$file}{mode};
241
242 # 2 possible types of return values:
243 #return -ENOENT(); # or any other error you care to
244 #print(join(",",($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)),"\n");
245 return ($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
246 }
247
248 sub e_getdir {
249 my ($dirname) = shift;
250 $dirname =~ s!^/!!;
251 # return as many text filenames as you like, followed by the retval.
252 print((scalar keys %files)." files total\n");
253 my %out;
254 foreach my $f (sort keys %files) {
255 if ($dirname) {
256 if ($f =~ s/^\E$dirname\Q\///) {
257 $out{$f}++ if ($f =~ /^[^\/]+$/);
258 }
259 } else {
260 $out{$f}++ if ($f =~ /^[^\/]+$/);
261 }
262 }
263 if (! %out) {
264 $out{'no files? bug?'}++;
265 }
266 print scalar keys %out," files in dir '$dirname'\n";
267 print "## ",join(" ",keys %out),"\n";
268 return (keys %out),0;
269 }
270
271 sub read_content {
272 my ($file,$id) = @_;
273
274 die "read_content needs file and id" unless ($file && $id);
275
276 $sth->{'read'}->execute($id) || die $sth->{'read'}->errstr;
277 $files{$file}{cont} = $sth->{'read'}->fetchrow_array;
278 print "file '$file' content [",length($files{$file}{cont})," bytes] read in cache\n";
279 }
280
281
282 sub e_open {
283 # VFS sanity check; it keeps all the necessary state, not much to do here.
284 my $file = filename_fixup(shift);
285 my $flags = shift;
286
287 return -ENOENT() unless exists($files{$file});
288 return -EISDIR() unless exists($files{$file}{id});
289
290 read_content($file,$files{$file}{id}) unless exists($files{$file}{cont});
291
292 print "open '$file' ",length($files{$file}{cont})," bytes\n";
293 return 0;
294 }
295
296 sub e_read {
297 # return an error numeric, or binary/text string.
298 # (note: 0 means EOF, "0" will give a byte (ascii "0")
299 # to the reading program)
300 my ($file) = filename_fixup(shift);
301 my ($buf_len,$off) = @_;
302
303 return -ENOENT() unless exists($files{$file});
304
305 my $len = length($files{$file}{cont});
306
307 print "read '$file' [$len bytes] offset $off length $buf_len\n";
308
309 return -EINVAL() if ($off > $len);
310 return 0 if ($off == $len);
311
312 $buf_len = $len-$off if ($len - $off < $buf_len);
313
314 return substr($files{$file}{cont},$off,$buf_len);
315 }
316
317 sub clear_cont {
318 print "transaction rollback\n";
319 $dbh->rollback || die $dbh->errstr;
320 print "invalidate all cached content\n";
321 foreach my $f (keys %files) {
322 delete $files{$f}{cont};
323 }
324 print "begin new transaction\n";
325 #$dbh->begin_work || die $dbh->errstr;
326 }
327
328
329 sub update_db {
330 my $file = shift || die;
331
332 $files{$file}{ctime} = time();
333
334 my ($cont,$id) = (
335 $files{$file}{cont},
336 $files{$file}{id}
337 );
338
339 if (!$sth->{'update'}->execute($cont,$id)) {
340 print "update problem: ",$sth->{'update'}->errstr;
341 clear_cont;
342 return 0;
343 } else {
344 if (! $dbh->commit) {
345 print "ERROR: commit problem: ",$sth->{'update'}->errstr;
346 clear_cont;
347 return 0;
348 }
349 print "updated '$file' [",$files{$file}{id},"]\n";
350 }
351 return 1;
352 }
353
354 sub e_write {
355 my $file = filename_fixup(shift);
356 my ($buffer,$off) = @_;
357
358 return -ENOENT() unless exists($files{$file});
359
360 my $cont = $files{$file}{cont};
361 my $len = length($cont);
362
363 print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
364
365 $files{$file}{cont} = "";
366
367 $files{$file}{cont} .= substr($cont,0,$off) if ($off > 0);
368 $files{$file}{cont} .= $buffer;
369 $files{$file}{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);
370
371 $files{$file}{size} = length($files{$file}{cont});
372
373 if (! update_db($file)) {
374 return -ENOSYS();
375 } else {
376 return length($buffer);
377 }
378 }
379
380 sub e_truncate {
381 my $file = filename_fixup(shift);
382 my $size = shift;
383
384 print "truncate to $size\n";
385
386 $files{$file}{cont} = substr($files{$file}{cont},0,$size);
387 $files{$file}{size} = $size;
388 return 0
389 };
390
391
392 sub e_utime {
393 my ($atime,$mtime,$file) = @_;
394 $file = filename_fixup($file);
395
396 return -ENOENT() unless exists($files{$file});
397
398 print "utime '$file' $atime $mtime\n";
399
400 $files{$file}{time} = $mtime;
401 return 0;
402 }
403
404 sub e_statfs { return 255, 1, 1, 1, 1, 2 }
405
406 sub e_unlink {
407 my $file = filename_fixup(shift);
408
409 return -ENOENT() unless exists($files{$file});
410
411 print "unlink '$file' will invalidate cache\n";
412
413 read_content($file,$files{$file}{id});
414
415 return 0;
416 }
417 1;
418 __END__
419
420 =head1 EXPORT
421
422 Nothing.
423
424 =head1 SEE ALSO
425
426 C<FUSE (Filesystem in USErspace)> website
427 L<http://sourceforge.net/projects/avf>
428
429 =head1 AUTHOR
430
431 Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
432
433 =head1 COPYRIGHT AND LICENSE
434
435 Copyright (C) 2004 by Dobrica Pavlinusic
436
437 This library is free software; you can redistribute it and/or modify
438 it under the same terms as Perl itself, either Perl version 5.8.4 or,
439 at your option, any later version of Perl 5 you may have available.
440
441
442 =cut
443

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26