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