SQLite test is finally working,
[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.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://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                 $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://sourceforge.net/projects/avf>
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