/[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 36 - (show annotations)
Tue Nov 16 15:34:25 2004 UTC (19 years, 4 months ago) by dpavlin
File size: 11989 byte(s)
update URL to fuse web site

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.05';
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 C<run> below for examples how to set parameters.
28
29 =head1 DESCRIPTION
30
31 This module will use C<Fuse> module, part of C<FUSE (Filesystem in USErspace)>
32 available at L<http://fuse.sourceforge.net/> to mount
33 your database as file system.
34
35 That will give you possibility 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 Let's suppose that your database have table C<files> with following structure:
50
51 id: int
52 filename: text
53 size: int
54 content: text
55 writable: boolean
56
57 Following is example how to mount table like that to C</mnt>:
58
59 my $mnt = Fuse::DBI->mount({
60 'filenames' => 'select id,filename,size,writable from files',
61 'read' => 'select content from files where id = ?',
62 'update' => 'update files set content = ? where id = ?',
63 'dsn' => 'DBI:Pg:dbname=test_db',
64 'user' => 'database_user',
65 'password' => 'database_password',
66 'invalidate' => sub { ... },
67 });
68
69 Options:
70
71 =over 5
72
73 =item filenames
74
75 SQL query which returns C<id> (unique id for that row), C<filename>,
76 C<size> and C<writable> boolean flag.
77
78 =item read
79
80 SQL query which returns only one column with content of file and has
81 placeholder C<?> for C<id>.
82
83 =item update
84
85 SQL query with two pace-holders, one for new content and one for C<id>.
86
87 =item dsn
88
89 C<DBI> dsn to connect to (contains database driver and name of database).
90
91 =item user
92
93 User with which to connect to database
94
95 =item password
96
97 Password for connecting to database
98
99 =item invalidate
100
101 Optional anonymous code reference which will be executed when data is updated in
102 database. It can be used as hook to delete cache (for example on-disk-cache)
103 which is created from data edited through C<Fuse::DBI>.
104
105 =item fork
106
107 Optional flag which forks after mount so that executing script will continue
108 running. Implementation is experimental.
109
110 =back
111
112 =cut
113
114 my $dbh;
115 my $sth;
116 my $ctime_start;
117
118 sub read_filenames;
119 sub fuse_module_loaded;
120
121 # evil, evil way to solve this. It makes this module non-reentrant. But, since
122 # fuse calls another copy of this script for each mount anyway, this shouldn't
123 # be a problem.
124 my $fuse_self;
125
126 sub mount {
127 my $class = shift;
128 my $self = {};
129 bless($self, $class);
130
131 my $arg = shift;
132
133 print Dumper($arg);
134
135 carp "mount needs 'dsn' to connect to (e.g. dsn => 'DBI:Pg:dbname=test')" unless ($arg->{'dsn'});
136 carp "mount needs 'mount' as mountpoint" unless ($arg->{'mount'});
137
138 # save (some) arguments in self
139 foreach (qw(mount invalidate)) {
140 $self->{$_} = $arg->{$_};
141 }
142
143 foreach (qw(filenames read update)) {
144 carp "mount needs '$_' SQL" unless ($arg->{$_});
145 }
146
147 $ctime_start = time();
148
149 my $pid;
150 if ($arg->{'fork'}) {
151 $self->{'mounted'} = 1;
152 $pid = fork();
153 die "fork() failed: $!" unless defined $pid;
154 # child will return to caller
155 if ($pid) {
156 return $self;
157 }
158 }
159
160 $dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, {AutoCommit => 0, RaiseError => 1}) || die $DBI::errstr;
161
162 $sth->{'filenames'} = $dbh->prepare($arg->{'filenames'}) || die $dbh->errstr();
163
164 $sth->{'read'} = $dbh->prepare($arg->{'read'}) || die $dbh->errstr();
165 $sth->{'update'} = $dbh->prepare($arg->{'update'}) || die $dbh->errstr();
166
167
168 $self->{'sth'} = $sth;
169
170 $self->{'read_filenames'} = sub { $self->read_filenames };
171 $self->read_filenames;
172
173 $self->{'mounted'} = 1 unless ($arg->{'fork'});
174
175 $fuse_self = \$self;
176
177 Fuse::main(
178 mountpoint=>$arg->{'mount'},
179 getattr=>\&e_getattr,
180 getdir=>\&e_getdir,
181 open=>\&e_open,
182 statfs=>\&e_statfs,
183 read=>\&e_read,
184 write=>\&e_write,
185 utime=>\&e_utime,
186 truncate=>\&e_truncate,
187 unlink=>\&e_unlink,
188 rmdir=>\&e_unlink,
189 debug=>0,
190 );
191
192 $self->{'mounted'} = 0;
193
194 exit(0) if ($arg->{'fork'});
195
196 return 1;
197
198 };
199
200 =head2 umount
201
202 Unmount your database as filesystem.
203
204 $mnt->umount;
205
206 This will also kill background process which is translating
207 database to filesystem.
208
209 =cut
210
211 sub umount {
212 my $self = shift;
213
214 if ($self->{'mounted'}) {
215 system "fusermount -u ".$self->{'mount'} || warn "umount error: $!" && return 0;
216 }
217
218 return 1;
219 }
220
221 $SIG{'INT'} = sub {
222 print STDERR "umount called by SIG INT\n";
223 umount;
224 };
225
226 sub DESTROY {
227 my $self = shift;
228 return if (! $self->{'mounted'});
229 print STDERR "umount called by DESTROY\n";
230 $self->umount;
231 }
232
233 =head2 fuse_module_loaded
234
235 Checks if C<fuse> module is loaded in kernel.
236
237 die "no fuse module loaded in kernel"
238 unless (Fuse::DBI::fuse_module_loaded);
239
240 This function in called by C<mount>, but might be useful alone also.
241
242 =cut
243
244 sub fuse_module_loaded {
245 my $lsmod = `lsmod`;
246 die "can't start lsmod: $!" unless ($lsmod);
247 if ($lsmod =~ m/fuse/s) {
248 return 1;
249 } else {
250 return 0;
251 }
252 }
253
254 my %files;
255 my %dirs;
256
257 sub read_filenames {
258 my $self = shift;
259
260 my $sth = $self->{'sth'} || die "no sth argument";
261
262 # create empty filesystem
263 (%files) = (
264 '.' => {
265 type => 0040,
266 mode => 0755,
267 },
268 # a => {
269 # cont => "File 'a'.\n",
270 # type => 0100,
271 # ctime => time()-2000
272 # },
273 );
274
275 # fetch new filename list from database
276 $sth->{'filenames'}->execute() || die $sth->{'filenames'}->errstr();
277
278 # read them in with sesible defaults
279 while (my $row = $sth->{'filenames'}->fetchrow_hashref() ) {
280 $files{$row->{'filename'}} = {
281 size => $row->{'size'},
282 mode => $row->{'writable'} ? 0644 : 0444,
283 id => $row->{'id'} || 99,
284 };
285
286 my $d;
287 foreach (split(m!/!, $row->{'filename'})) {
288 # first, entry is assumed to be file
289 if ($d) {
290 $files{$d} = {
291 size => $dirs{$d}++,
292 mode => 0755,
293 type => 0040
294 };
295 $files{$d.'/.'} = {
296 mode => 0755,
297 type => 0040
298 };
299 $files{$d.'/..'} = {
300 mode => 0755,
301 type => 0040
302 };
303 }
304 $d .= "/" if ($d);
305 $d .= "$_";
306 }
307 }
308
309 print "found ",scalar(keys %files)-scalar(keys %dirs)," files, ",scalar(keys %dirs), " dirs\n";
310 }
311
312
313 sub filename_fixup {
314 my ($file) = shift;
315 $file =~ s,^/,,;
316 $file = '.' unless length($file);
317 return $file;
318 }
319
320 sub e_getattr {
321 my ($file) = filename_fixup(shift);
322 $file =~ s,^/,,;
323 $file = '.' unless length($file);
324 return -ENOENT() unless exists($files{$file});
325 my ($size) = $files{$file}{size} || 1;
326 my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,1,0,0,1,1024);
327 my ($atime, $ctime, $mtime);
328 $atime = $ctime = $mtime = $files{$file}{ctime} || $ctime_start;
329
330 my ($modes) = (($files{$file}{type} || 0100)<<9) + $files{$file}{mode};
331
332 # 2 possible types of return values:
333 #return -ENOENT(); # or any other error you care to
334 #print(join(",",($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)),"\n");
335 return ($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
336 }
337
338 sub e_getdir {
339 my ($dirname) = shift;
340 $dirname =~ s!^/!!;
341 # return as many text filenames as you like, followed by the retval.
342 print((scalar keys %files)." files total\n");
343 my %out;
344 foreach my $f (sort keys %files) {
345 if ($dirname) {
346 if ($f =~ s/^\Q$dirname\E\///) {
347 $out{$f}++ if ($f =~ /^[^\/]+$/);
348 }
349 } else {
350 $out{$f}++ if ($f =~ /^[^\/]+$/);
351 }
352 }
353 if (! %out) {
354 $out{'no files? bug?'}++;
355 }
356 print scalar keys %out," files in dir '$dirname'\n";
357 print "## ",join(" ",keys %out),"\n";
358 return (keys %out),0;
359 }
360
361 sub read_content {
362 my ($file,$id) = @_;
363
364 die "read_content needs file and id" unless ($file && $id);
365
366 $sth->{'read'}->execute($id) || die $sth->{'read'}->errstr;
367 $files{$file}{cont} = $sth->{'read'}->fetchrow_array;
368 # I should modify ctime only if content in database changed
369 #$files{$file}{ctime} = time() unless ($files{$file}{ctime});
370 print "file '$file' content [",length($files{$file}{cont})," bytes] read in cache\n";
371 }
372
373
374 sub e_open {
375 # VFS sanity check; it keeps all the necessary state, not much to do here.
376 my $file = filename_fixup(shift);
377 my $flags = shift;
378
379 return -ENOENT() unless exists($files{$file});
380 return -EISDIR() unless exists($files{$file}{id});
381
382 read_content($file,$files{$file}{id}) unless exists($files{$file}{cont});
383
384 print "open '$file' ",length($files{$file}{cont})," bytes\n";
385 return 0;
386 }
387
388 sub e_read {
389 # return an error numeric, or binary/text string.
390 # (note: 0 means EOF, "0" will give a byte (ascii "0")
391 # to the reading program)
392 my ($file) = filename_fixup(shift);
393 my ($buf_len,$off) = @_;
394
395 return -ENOENT() unless exists($files{$file});
396
397 my $len = length($files{$file}{cont});
398
399 print "read '$file' [$len bytes] offset $off length $buf_len\n";
400
401 return -EINVAL() if ($off > $len);
402 return 0 if ($off == $len);
403
404 $buf_len = $len-$off if ($len - $off < $buf_len);
405
406 return substr($files{$file}{cont},$off,$buf_len);
407 }
408
409 sub clear_cont {
410 print "transaction rollback\n";
411 $dbh->rollback || die $dbh->errstr;
412 print "invalidate all cached content\n";
413 foreach my $f (keys %files) {
414 delete $files{$f}{cont};
415 delete $files{$f}{ctime};
416 }
417 print "begin new transaction\n";
418 #$dbh->begin_work || die $dbh->errstr;
419 }
420
421
422 sub update_db {
423 my $file = shift || die;
424
425 $files{$file}{ctime} = time();
426
427 my ($cont,$id) = (
428 $files{$file}{cont},
429 $files{$file}{id}
430 );
431
432 if (!$sth->{'update'}->execute($cont,$id)) {
433 print "update problem: ",$sth->{'update'}->errstr;
434 clear_cont;
435 return 0;
436 } else {
437 if (! $dbh->commit) {
438 print "ERROR: commit problem: ",$sth->{'update'}->errstr;
439 clear_cont;
440 return 0;
441 }
442 print "updated '$file' [",$files{$file}{id},"]\n";
443
444 $$fuse_self->{'invalidate'}->() if (ref $$fuse_self->{'invalidate'});
445 }
446 return 1;
447 }
448
449 sub e_write {
450 my $file = filename_fixup(shift);
451 my ($buffer,$off) = @_;
452
453 return -ENOENT() unless exists($files{$file});
454
455 my $cont = $files{$file}{cont};
456 my $len = length($cont);
457
458 print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
459
460 $files{$file}{cont} = "";
461
462 $files{$file}{cont} .= substr($cont,0,$off) if ($off > 0);
463 $files{$file}{cont} .= $buffer;
464 $files{$file}{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);
465
466 $files{$file}{size} = length($files{$file}{cont});
467
468 if (! update_db($file)) {
469 return -ENOSYS();
470 } else {
471 return length($buffer);
472 }
473 }
474
475 sub e_truncate {
476 my $file = filename_fixup(shift);
477 my $size = shift;
478
479 print "truncate to $size\n";
480
481 $files{$file}{cont} = substr($files{$file}{cont},0,$size);
482 $files{$file}{size} = $size;
483 return 0
484 };
485
486
487 sub e_utime {
488 my ($atime,$mtime,$file) = @_;
489 $file = filename_fixup($file);
490
491 return -ENOENT() unless exists($files{$file});
492
493 print "utime '$file' $atime $mtime\n";
494
495 $files{$file}{time} = $mtime;
496 return 0;
497 }
498
499 sub e_statfs { return 255, 1, 1, 1, 1, 2 }
500
501 sub e_unlink {
502 my $file = filename_fixup(shift);
503
504 if (exists( $dirs{$file} )) {
505 print "unlink '$file' will re-read template names\n";
506 print Dumper($fuse_self);
507 $$fuse_self->{'read_filenames'}->();
508 return 0;
509 } elsif (exists( $files{$file} )) {
510 print "unlink '$file' will invalidate cache\n";
511 read_content($file,$files{$file}{id});
512 return 0;
513 }
514
515 return -ENOENT();
516 }
517 1;
518 __END__
519
520 =head1 EXPORT
521
522 Nothing.
523
524 =head1 SEE ALSO
525
526 C<FUSE (Filesystem in USErspace)> website
527 L<http://fuse.sourceforge.net/>
528
529 Example for WebGUI which comes with this distribution in
530 directory C<examples/webgui.pl>. It also contains a lot of documentation
531 about design of this module, usage and limitations.
532
533 =head1 AUTHOR
534
535 Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
536
537 =head1 COPYRIGHT AND LICENSE
538
539 Copyright (C) 2004 by Dobrica Pavlinusic
540
541 This library is free software; you can redistribute it and/or modify
542 it under the same terms as Perl itself, either Perl version 5.8.4 or,
543 at your option, any later version of Perl 5 you may have available.
544
545
546 =cut
547

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26