03744028e7a2592d50da140c2e850a5ac596e674
[Fuse-DBI] / DBI.pm
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.04';
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://sourceforge.net/projects/avf> 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                 $pid = fork();
152                 die "fork() failed: $!" unless defined $pid;
153                 # child will return to caller
154                 if ($pid) {
155                         return $self;
156                 }
157         }
158
159         $dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, {AutoCommit => 0, RaiseError => 1}) || die $DBI::errstr;
160
161         $sth->{'filenames'} = $dbh->prepare($arg->{'filenames'}) || die $dbh->errstr();
162
163         $sth->{'read'} = $dbh->prepare($arg->{'read'}) || die $dbh->errstr();
164         $sth->{'update'} = $dbh->prepare($arg->{'update'}) || die $dbh->errstr();
165
166
167         $self->{'sth'} = $sth;
168
169         $self->{'read_filenames'} = sub { $self->read_filenames };
170         $self->read_filenames;
171
172         $self->{'mounted'} = 1;
173
174         $fuse_self = \$self;
175
176         Fuse::main(
177                 mountpoint=>$arg->{'mount'},
178                 getattr=>\&e_getattr,
179                 getdir=>\&e_getdir,
180                 open=>\&e_open,
181                 statfs=>\&e_statfs,
182                 read=>\&e_read,
183                 write=>\&e_write,
184                 utime=>\&e_utime,
185                 truncate=>\&e_truncate,
186                 unlink=>\&e_unlink,
187                 rmdir=>\&e_unlink,
188                 debug=>0,
189         );
190         
191         $self->{'mounted'} = 0;
192
193         exit(0) if ($arg->{'fork'});
194
195         return 1;
196
197 };
198
199 =head2 umount
200
201 Unmount your database as filesystem.
202
203   $mnt->umount;
204
205 This will also kill background process which is translating
206 database to filesystem.
207
208 =cut
209
210 sub umount {
211         my $self = shift;
212
213         if ($self->{'mounted'}) {
214                 system "fusermount -u ".$self->{'mount'} || croak "umount error: $!";
215         }
216
217         return 1;
218 }
219
220 $SIG{'INT'} = sub {
221         print STDERR "umount called by SIG INT\n";
222         umount;
223 };
224
225 sub DESTROY {
226         my $self = shift;
227         return if (! $self->{'mounted'});
228         print STDERR "umount called by DESTROY\n";
229         $self->umount;
230 }
231
232 =head2 fuse_module_loaded
233
234 Checks if C<fuse> module is loaded in kernel.
235
236   die "no fuse module loaded in kernel"
237         unless (Fuse::DBI::fuse_module_loaded);
238
239 This function in called by C<mount>, but might be useful alone also.
240
241 =cut
242
243 sub fuse_module_loaded {
244         my $lsmod = `lsmod`;
245         die "can't start lsmod: $!" unless ($lsmod);
246         if ($lsmod =~ m/fuse/s) {
247                 return 1;
248         } else {
249                 return 0;
250         }
251 }
252
253 my %files;
254 my %dirs;
255
256 sub read_filenames {
257         my $self = shift;
258
259         my $sth = $self->{'sth'} || die "no sth argument";
260
261         # create empty filesystem
262         (%files) = (
263                 '.' => {
264                         type => 0040,
265                         mode => 0755,
266                 },
267         #       a => {
268         #               cont => "File 'a'.\n",
269         #               type => 0100,
270         #               ctime => time()-2000
271         #       },
272         );
273
274         # fetch new filename list from database
275         $sth->{'filenames'}->execute() || die $sth->{'filenames'}->errstr();
276
277         # read them in with sesible defaults
278         while (my $row = $sth->{'filenames'}->fetchrow_hashref() ) {
279                 $files{$row->{'filename'}} = {
280                         size => $row->{'size'},
281                         mode => $row->{'writable'} ? 0644 : 0444,
282                         id => $row->{'id'} || 99,
283                 };
284
285                 my $d;
286                 foreach (split(m!/!, $row->{'filename'})) {
287                         # first, entry is assumed to be file
288                         if ($d) {
289                                 $files{$d} = {
290                                                 size => $dirs{$d}++,
291                                                 mode => 0755,
292                                                 type => 0040
293                                 };
294                                 $files{$d.'/.'} = {
295                                                 mode => 0755,
296                                                 type => 0040
297                                 };
298                                 $files{$d.'/..'} = {
299                                                 mode => 0755,
300                                                 type => 0040
301                                 };
302                         }
303                         $d .= "/" if ($d);
304                         $d .= "$_";
305                 }
306         }
307
308         print "found ",scalar(keys %files)-scalar(keys %dirs)," files, ",scalar(keys %dirs), " dirs\n";
309 }
310
311
312 sub filename_fixup {
313         my ($file) = shift;
314         $file =~ s,^/,,;
315         $file = '.' unless length($file);
316         return $file;
317 }
318
319 sub e_getattr {
320         my ($file) = filename_fixup(shift);
321         $file =~ s,^/,,;
322         $file = '.' unless length($file);
323         return -ENOENT() unless exists($files{$file});
324         my ($size) = $files{$file}{size} || 1;
325         my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,1,0,0,1,1024);
326         my ($atime, $ctime, $mtime);
327         $atime = $ctime = $mtime = $files{$file}{ctime} || $ctime_start;
328
329         my ($modes) = (($files{$file}{type} || 0100)<<9) + $files{$file}{mode};
330
331         # 2 possible types of return values:
332         #return -ENOENT(); # or any other error you care to
333         #print(join(",",($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)),"\n");
334         return ($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
335 }
336
337 sub e_getdir {
338         my ($dirname) = shift;
339         $dirname =~ s!^/!!;
340         # return as many text filenames as you like, followed by the retval.
341         print((scalar keys %files)." files total\n");
342         my %out;
343         foreach my $f (sort keys %files) {
344                 if ($dirname) {
345                         if ($f =~ s/^\E$dirname\Q\///) {
346                                 $out{$f}++ if ($f =~ /^[^\/]+$/);
347                         }
348                 } else {
349                         $out{$f}++ if ($f =~ /^[^\/]+$/);
350                 }
351         }
352         if (! %out) {
353                 $out{'no files? bug?'}++;
354         }
355         print scalar keys %out," files in dir '$dirname'\n";
356         print "## ",join(" ",keys %out),"\n";
357         return (keys %out),0;
358 }
359
360 sub read_content {
361         my ($file,$id) = @_;
362
363         die "read_content needs file and id" unless ($file && $id);
364
365         $sth->{'read'}->execute($id) || die $sth->{'read'}->errstr;
366         $files{$file}{cont} = $sth->{'read'}->fetchrow_array;
367         $files{$file}{ctime} = time();
368         print "file '$file' content [",length($files{$file}{cont})," bytes] read in cache\n";
369 }
370
371
372 sub e_open {
373         # VFS sanity check; it keeps all the necessary state, not much to do here.
374         my $file = filename_fixup(shift);
375         my $flags = shift;
376
377         return -ENOENT() unless exists($files{$file});
378         return -EISDIR() unless exists($files{$file}{id});
379
380         read_content($file,$files{$file}{id}) unless exists($files{$file}{cont});
381
382         print "open '$file' ",length($files{$file}{cont})," bytes\n";
383         return 0;
384 }
385
386 sub e_read {
387         # return an error numeric, or binary/text string.
388         # (note: 0 means EOF, "0" will give a byte (ascii "0")
389         # to the reading program)
390         my ($file) = filename_fixup(shift);
391         my ($buf_len,$off) = @_;
392
393         return -ENOENT() unless exists($files{$file});
394
395         my $len = length($files{$file}{cont});
396
397         print "read '$file' [$len bytes] offset $off length $buf_len\n";
398
399         return -EINVAL() if ($off > $len);
400         return 0 if ($off == $len);
401
402         $buf_len = $len-$off if ($len - $off < $buf_len);
403
404         return substr($files{$file}{cont},$off,$buf_len);
405 }
406
407 sub clear_cont {
408         print "transaction rollback\n";
409         $dbh->rollback || die $dbh->errstr;
410         print "invalidate all cached content\n";
411         foreach my $f (keys %files) {
412                 delete $files{$f}{cont};
413         }
414         print "begin new transaction\n";
415         #$dbh->begin_work || die $dbh->errstr;
416 }
417
418
419 sub update_db {
420         my $file = shift || die;
421
422         $files{$file}{ctime} = time();
423
424         my ($cont,$id) = (
425                 $files{$file}{cont},
426                 $files{$file}{id}
427         );
428
429         if (!$sth->{'update'}->execute($cont,$id)) {
430                 print "update problem: ",$sth->{'update'}->errstr;
431                 clear_cont;
432                 return 0;
433         } else {
434                 if (! $dbh->commit) {
435                         print "ERROR: commit problem: ",$sth->{'update'}->errstr;
436                         clear_cont;
437                         return 0;
438                 }
439                 print "updated '$file' [",$files{$file}{id},"]\n";
440
441                 $$fuse_self->{'invalidate'}->() if (ref $$fuse_self->{'invalidate'});
442         }
443         return 1;
444 }
445
446 sub e_write {
447         my $file = filename_fixup(shift);
448         my ($buffer,$off) = @_;
449
450         return -ENOENT() unless exists($files{$file});
451
452         my $cont = $files{$file}{cont};
453         my $len = length($cont);
454
455         print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
456
457         $files{$file}{cont} = "";
458
459         $files{$file}{cont} .= substr($cont,0,$off) if ($off > 0);
460         $files{$file}{cont} .= $buffer;
461         $files{$file}{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);
462
463         $files{$file}{size} = length($files{$file}{cont});
464
465         if (! update_db($file)) {
466                 return -ENOSYS();
467         } else {
468                 return length($buffer);
469         }
470 }
471
472 sub e_truncate {
473         my $file = filename_fixup(shift);
474         my $size = shift;
475
476         print "truncate to $size\n";
477
478         $files{$file}{cont} = substr($files{$file}{cont},0,$size);
479         $files{$file}{size} = $size;
480         return 0
481 };
482
483
484 sub e_utime {
485         my ($atime,$mtime,$file) = @_;
486         $file = filename_fixup($file);
487
488         return -ENOENT() unless exists($files{$file});
489
490         print "utime '$file' $atime $mtime\n";
491
492         $files{$file}{time} = $mtime;
493         return 0;
494 }
495
496 sub e_statfs { return 255, 1, 1, 1, 1, 2 }
497
498 sub e_unlink {
499         my $file = filename_fixup(shift);
500
501         if (exists( $dirs{$file} )) {
502                 print "unlink '$file' will re-read template names\n";
503                 print Dumper($fuse_self);
504                 $$fuse_self->{'read_filenames'}->();
505                 return 0;
506         } elsif (exists( $files{$file} )) {
507                 print "unlink '$file' will invalidate cache\n";
508                 read_content($file,$files{$file}{id});
509                 return 0;
510         }
511
512         return -ENOENT();
513 }
514 1;
515 __END__
516
517 =head1 EXPORT
518
519 Nothing.
520
521 =head1 SEE ALSO
522
523 C<FUSE (Filesystem in USErspace)> website
524 L<http://sourceforge.net/projects/avf>
525
526 Example for WebGUI which comes with this distribution in
527 directory C<examples/webgui.pl>. It also contains a lot of documentation
528 about design of this module, usage and limitations.
529
530 =head1 AUTHOR
531
532 Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
533
534 =head1 COPYRIGHT AND LICENSE
535
536 Copyright (C) 2004 by Dobrica Pavlinusic
537
538 This library is free software; you can redistribute it and/or modify
539 it under the same terms as Perl itself, either Perl version 5.8.4 or,
540 at your option, any later version of Perl 5 you may have available.
541
542
543 =cut
544