9 use POSIX qw(ENOENT EISDIR EINVAL ENOSYS O_RDWR);
16 our $VERSION = '0.06';
20 Fuse::DBI - mount your database as filesystem and use it
25 Fuse::DBI->mount( ... );
27 See C<run> below for examples how to set parameters.
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.
35 That will give you possibility to use normal file-system tools (cat, grep, vi)
36 to manipulate data in database.
38 It's actually opposite of Oracle's intention to put everything into database.
47 Mount your database as filesystem.
49 Let's suppose that your database have table C<files> with following structure:
57 Following is example how to mount table like that to C</mnt>:
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 { ... },
75 SQL query which returns C<id> (unique id for that row), C<filename>,
76 C<size> and C<writable> boolean flag.
80 SQL query which returns only one column with content of file and has
81 placeholder C<?> for C<id>.
85 SQL query with two pace-holders, one for new content and one for C<id>.
89 C<DBI> dsn to connect to (contains database driver and name of database).
93 User with which to connect to database
97 Password for connecting to database
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>.
107 Optional flag which forks after mount so that executing script will continue
108 running. Implementation is experimental.
119 sub fuse_module_loaded;
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
129 bless($self, $class);
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'});
138 # save (some) arguments in self
139 foreach (qw(mount invalidate)) {
140 $self->{$_} = $arg->{$_};
143 foreach (qw(filenames read update)) {
144 carp "mount needs '$_' SQL" unless ($arg->{$_});
147 $ctime_start = time();
150 if ($arg->{'fork'}) {
152 die "fork() failed: $!" unless defined $pid;
153 # child will return to caller
159 $dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, {AutoCommit => 0, RaiseError => 1}) || die $DBI::errstr;
161 $sth->{'filenames'} = $dbh->prepare($arg->{'filenames'}) || die $dbh->errstr();
163 $sth->{'read'} = $dbh->prepare($arg->{'read'}) || die $dbh->errstr();
164 $sth->{'update'} = $dbh->prepare($arg->{'update'}) || die $dbh->errstr();
167 $self->{'sth'} = $sth;
169 $self->{'read_filenames'} = sub { $self->read_filenames };
170 $self->read_filenames;
175 mountpoint=>$arg->{'mount'},
176 getattr=>\&e_getattr,
183 truncate=>\&e_truncate,
189 exit(0) if ($arg->{'fork'});
197 Unmount your database as filesystem.
201 This will also kill background process which is translating
202 database to filesystem.
209 if ($self->{'mount'}) {
210 if (open(MTAB, "/etc/mtab")) {
212 my $mount = $self->{'mount'};
214 $mounted = 1 if (/ $mount fuse /i);
219 system "fusermount -u ".$self->{'mount'}." 2>&1 >/dev/null" || return 0;
224 warn "can't open /etc/mtab: $!";
231 if ($fuse_self && $$fuse_self->umount) {
232 print STDERR "umount called by SIG INT\n";
237 if ($fuse_self && $$fuse_self->umount) {
238 print STDERR "umount called by SIG QUIT\n";
245 print STDERR "umount called by DESTROY\n";
249 =head2 fuse_module_loaded
251 Checks if C<fuse> module is loaded in kernel.
253 die "no fuse module loaded in kernel"
254 unless (Fuse::DBI::fuse_module_loaded);
256 This function in called by C<mount>, but might be useful alone also.
260 sub fuse_module_loaded {
262 die "can't start lsmod: $!" unless ($lsmod);
263 if ($lsmod =~ m/fuse/s) {
276 my $sth = $self->{'sth'} || die "no sth argument";
278 # create empty filesystem
289 # cont => "File 'a'.\n",
291 # ctime => time()-2000
295 # fetch new filename list from database
296 $sth->{'filenames'}->execute() || die $sth->{'filenames'}->errstr();
298 # read them in with sesible defaults
299 while (my $row = $sth->{'filenames'}->fetchrow_hashref() ) {
300 $files{$row->{'filename'}} = {
301 size => $row->{'size'},
302 mode => $row->{'writable'} ? 0644 : 0444,
303 id => $row->{'id'} || 99,
307 foreach (split(m!/!, $row->{'filename'})) {
308 # first, entry is assumed to be file
329 print "found ",scalar(keys %files)-scalar(keys %dirs)," files, ",scalar(keys %dirs), " dirs\n";
336 $file = '.' unless length($file);
341 my ($file) = filename_fixup(shift);
343 $file = '.' unless length($file);
344 return -ENOENT() unless exists($files{$file});
345 my ($size) = $files{$file}{size} || 1;
346 my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,1,0,0,1,1024);
347 my ($atime, $ctime, $mtime);
348 $atime = $ctime = $mtime = $files{$file}{ctime} || $ctime_start;
350 my ($modes) = (($files{$file}{type} || 0100)<<9) + $files{$file}{mode};
352 # 2 possible types of return values:
353 #return -ENOENT(); # or any other error you care to
354 #print(join(",",($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)),"\n");
355 return ($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
359 my ($dirname) = shift;
361 # return as many text filenames as you like, followed by the retval.
362 print((scalar keys %files)." files total\n");
364 foreach my $f (sort keys %files) {
366 if ($f =~ s/^\Q$dirname\E\///) {
367 $out{$f}++ if ($f =~ /^[^\/]+$/);
370 $out{$f}++ if ($f =~ /^[^\/]+$/);
374 $out{'no files? bug?'}++;
376 print scalar keys %out," files in dir '$dirname'\n";
377 print "## ",join(" ",keys %out),"\n";
378 return (keys %out),0;
384 die "read_content needs file and id" unless ($file && $id);
386 $sth->{'read'}->execute($id) || die $sth->{'read'}->errstr;
387 $files{$file}{cont} = $sth->{'read'}->fetchrow_array;
388 # I should modify ctime only if content in database changed
389 #$files{$file}{ctime} = time() unless ($files{$file}{ctime});
390 print "file '$file' content [",length($files{$file}{cont})," bytes] read in cache\n";
395 # VFS sanity check; it keeps all the necessary state, not much to do here.
396 my $file = filename_fixup(shift);
399 return -ENOENT() unless exists($files{$file});
400 return -EISDIR() unless exists($files{$file}{id});
402 read_content($file,$files{$file}{id}) unless exists($files{$file}{cont});
404 print "open '$file' ",length($files{$file}{cont})," bytes\n";
409 # return an error numeric, or binary/text string.
410 # (note: 0 means EOF, "0" will give a byte (ascii "0")
411 # to the reading program)
412 my ($file) = filename_fixup(shift);
413 my ($buf_len,$off) = @_;
415 return -ENOENT() unless exists($files{$file});
417 my $len = length($files{$file}{cont});
419 print "read '$file' [$len bytes] offset $off length $buf_len\n";
421 return -EINVAL() if ($off > $len);
422 return 0 if ($off == $len);
424 $buf_len = $len-$off if ($len - $off < $buf_len);
426 return substr($files{$file}{cont},$off,$buf_len);
430 print "transaction rollback\n";
431 $dbh->rollback || die $dbh->errstr;
432 print "invalidate all cached content\n";
433 foreach my $f (keys %files) {
434 delete $files{$f}{cont};
435 delete $files{$f}{ctime};
437 print "begin new transaction\n";
438 #$dbh->begin_work || die $dbh->errstr;
443 my $file = shift || die;
445 $files{$file}{ctime} = time();
452 if (!$sth->{'update'}->execute($cont,$id)) {
453 print "update problem: ",$sth->{'update'}->errstr;
457 if (! $dbh->commit) {
458 print "ERROR: commit problem: ",$sth->{'update'}->errstr;
462 print "updated '$file' [",$files{$file}{id},"]\n";
464 $$fuse_self->{'invalidate'}->() if (ref $$fuse_self->{'invalidate'});
470 my $file = filename_fixup(shift);
471 my ($buffer,$off) = @_;
473 return -ENOENT() unless exists($files{$file});
475 my $cont = $files{$file}{cont};
476 my $len = length($cont);
478 print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
480 $files{$file}{cont} = "";
482 $files{$file}{cont} .= substr($cont,0,$off) if ($off > 0);
483 $files{$file}{cont} .= $buffer;
484 $files{$file}{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);
486 $files{$file}{size} = length($files{$file}{cont});
488 if (! update_db($file)) {
491 return length($buffer);
496 my $file = filename_fixup(shift);
499 print "truncate to $size\n";
501 $files{$file}{cont} = substr($files{$file}{cont},0,$size);
502 $files{$file}{size} = $size;
508 my ($atime,$mtime,$file) = @_;
509 $file = filename_fixup($file);
511 return -ENOENT() unless exists($files{$file});
513 print "utime '$file' $atime $mtime\n";
515 $files{$file}{time} = $mtime;
519 sub e_statfs { return 255, 1, 1, 1, 1, 2 }
522 my $file = filename_fixup(shift);
524 if (exists( $dirs{$file} )) {
525 print "unlink '$file' will re-read template names\n";
526 print Dumper($fuse_self);
527 $$fuse_self->{'read_filenames'}->();
529 } elsif (exists( $files{$file} )) {
530 print "unlink '$file' will invalidate cache\n";
531 read_content($file,$files{$file}{id});
546 Size information (C<ls -s>) is wrong. It's a problem in upstream Fuse module
547 (for which I'm to blame lately), so when it gets fixes, C<Fuse::DBI> will
548 automagically pick it up.
552 C<FUSE (Filesystem in USErspace)> website
553 L<http://fuse.sourceforge.net/>
555 Example for WebGUI which comes with this distribution in
556 directory C<examples/webgui.pl>. It also contains a lot of documentation
557 about design of this module, usage and limitations.
561 Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
563 =head1 COPYRIGHT AND LICENSE
565 Copyright (C) 2004 by Dobrica Pavlinusic
567 This library is free software; you can redistribute it and/or modify
568 it under the same terms as Perl itself, either Perl version 5.8.4 or,
569 at your option, any later version of Perl 5 you may have available.