/[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

Annotation of /trunk/DBI.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 52 - (hide annotations)
Sat Nov 27 15:08:10 2004 UTC (19 years, 4 months ago) by dpavlin
File size: 13429 byte(s)
really remove all output from fusermount, define constant BLOCK to 1024
(used in various places)

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

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26