/[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 55 - (hide annotations)
Tue Apr 26 20:12:55 2005 UTC (17 years, 3 months ago) by dpavlin
File size: 13533 byte(s)
0.08: support for filenames which are null (it will ne named NULL-id)

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 55 our $VERSION = '0.08';
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 53 system "( fusermount -u ".$self->{'mount'}." 2>&1 ) >/dev/null";
253     if ($self->is_mounted) {
254 dpavlin 51 system "sudo umount ".$self->{'mount'} ||
255     return 0;
256 dpavlin 53 }
257 dpavlin 47 return 1;
258     }
259 dpavlin 40
260 dpavlin 47 return 0;
261 dpavlin 21 }
262    
263 dpavlin 26 $SIG{'INT'} = sub {
264 dpavlin 40 if ($fuse_self && $$fuse_self->umount) {
265     print STDERR "umount called by SIG INT\n";
266     }
267 dpavlin 26 };
268 dpavlin 24
269 dpavlin 40 $SIG{'QUIT'} = sub {
270     if ($fuse_self && $$fuse_self->umount) {
271     print STDERR "umount called by SIG QUIT\n";
272     }
273     };
274    
275 dpavlin 24 sub DESTROY {
276     my $self = shift;
277 dpavlin 40 if ($self->umount) {
278     print STDERR "umount called by DESTROY\n";
279     }
280 dpavlin 24 }
281    
282 dpavlin 21 =head2 fuse_module_loaded
283    
284     Checks if C<fuse> module is loaded in kernel.
285    
286     die "no fuse module loaded in kernel"
287     unless (Fuse::DBI::fuse_module_loaded);
288    
289 dpavlin 28 This function in called by C<mount>, but might be useful alone also.
290 dpavlin 21
291     =cut
292    
293     sub fuse_module_loaded {
294     my $lsmod = `lsmod`;
295     die "can't start lsmod: $!" unless ($lsmod);
296     if ($lsmod =~ m/fuse/s) {
297     return 1;
298 dpavlin 12 } else {
299 dpavlin 21 return 0;
300 dpavlin 12 }
301 dpavlin 11 }
302    
303 dpavlin 9 my %files;
304 dpavlin 1
305 dpavlin 9 sub read_filenames {
306 dpavlin 11 my $self = shift;
307    
308 dpavlin 26 my $sth = $self->{'sth'} || die "no sth argument";
309    
310 dpavlin 9 # create empty filesystem
311     (%files) = (
312     '.' => {
313     type => 0040,
314     mode => 0755,
315     },
316 dpavlin 40 '..' => {
317     type => 0040,
318     mode => 0755,
319     },
320 dpavlin 9 # a => {
321     # cont => "File 'a'.\n",
322     # type => 0100,
323     # ctime => time()-2000
324     # },
325     );
326 dpavlin 1
327 dpavlin 9 # fetch new filename list from database
328     $sth->{'filenames'}->execute() || die $sth->{'filenames'}->errstr();
329    
330     # read them in with sesible defaults
331     while (my $row = $sth->{'filenames'}->fetchrow_hashref() ) {
332 dpavlin 55 $row->{'filename'} ||= 'NULL-'.$row->{'id'};
333 dpavlin 9 $files{$row->{'filename'}} = {
334     size => $row->{'size'},
335     mode => $row->{'writable'} ? 0644 : 0444,
336     id => $row->{'id'} || 99,
337     };
338    
339 dpavlin 55
340 dpavlin 9 my $d;
341     foreach (split(m!/!, $row->{'filename'})) {
342     # first, entry is assumed to be file
343     if ($d) {
344     $files{$d} = {
345     mode => 0755,
346     type => 0040
347     };
348     $files{$d.'/.'} = {
349     mode => 0755,
350     type => 0040
351     };
352     $files{$d.'/..'} = {
353     mode => 0755,
354     type => 0040
355     };
356     }
357     $d .= "/" if ($d);
358     $d .= "$_";
359 dpavlin 1 }
360     }
361 dpavlin 9
362 dpavlin 51 print "found ",scalar(keys %files)," files\n";
363 dpavlin 1 }
364    
365    
366     sub filename_fixup {
367     my ($file) = shift;
368     $file =~ s,^/,,;
369     $file = '.' unless length($file);
370     return $file;
371     }
372    
373     sub e_getattr {
374     my ($file) = filename_fixup(shift);
375     $file =~ s,^/,,;
376     $file = '.' unless length($file);
377     return -ENOENT() unless exists($files{$file});
378 dpavlin 54 my ($size) = $files{$file}{size} || 0;
379 dpavlin 52 my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,int(($size+BLOCK-1)/BLOCK),0,0,1,BLOCK);
380 dpavlin 1 my ($atime, $ctime, $mtime);
381     $atime = $ctime = $mtime = $files{$file}{ctime} || $ctime_start;
382    
383     my ($modes) = (($files{$file}{type} || 0100)<<9) + $files{$file}{mode};
384    
385     # 2 possible types of return values:
386     #return -ENOENT(); # or any other error you care to
387 dpavlin 53 #print "getattr($file) ",join(",",($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)),"\n";
388 dpavlin 1 return ($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
389     }
390    
391     sub e_getdir {
392     my ($dirname) = shift;
393     $dirname =~ s!^/!!;
394     # return as many text filenames as you like, followed by the retval.
395     print((scalar keys %files)." files total\n");
396     my %out;
397 dpavlin 13 foreach my $f (sort keys %files) {
398 dpavlin 1 if ($dirname) {
399 dpavlin 32 if ($f =~ s/^\Q$dirname\E\///) {
400 dpavlin 13 $out{$f}++ if ($f =~ /^[^\/]+$/);
401     }
402 dpavlin 1 } else {
403     $out{$f}++ if ($f =~ /^[^\/]+$/);
404     }
405     }
406     if (! %out) {
407     $out{'no files? bug?'}++;
408     }
409 dpavlin 8 print scalar keys %out," files in dir '$dirname'\n";
410 dpavlin 13 print "## ",join(" ",keys %out),"\n";
411 dpavlin 1 return (keys %out),0;
412     }
413    
414 dpavlin 21 sub read_content {
415     my ($file,$id) = @_;
416    
417     die "read_content needs file and id" unless ($file && $id);
418    
419     $sth->{'read'}->execute($id) || die $sth->{'read'}->errstr;
420     $files{$file}{cont} = $sth->{'read'}->fetchrow_array;
421 dpavlin 31 # I should modify ctime only if content in database changed
422     #$files{$file}{ctime} = time() unless ($files{$file}{ctime});
423 dpavlin 21 print "file '$file' content [",length($files{$file}{cont})," bytes] read in cache\n";
424     }
425    
426    
427 dpavlin 1 sub e_open {
428     # VFS sanity check; it keeps all the necessary state, not much to do here.
429 dpavlin 6 my $file = filename_fixup(shift);
430     my $flags = shift;
431    
432 dpavlin 1 return -ENOENT() unless exists($files{$file});
433     return -EISDIR() unless exists($files{$file}{id});
434 dpavlin 6
435 dpavlin 21 read_content($file,$files{$file}{id}) unless exists($files{$file}{cont});
436    
437 dpavlin 54 $files{$file}{cont} ||= '';
438 dpavlin 3 print "open '$file' ",length($files{$file}{cont})," bytes\n";
439 dpavlin 1 return 0;
440     }
441    
442     sub e_read {
443 dpavlin 3 # return an error numeric, or binary/text string.
444     # (note: 0 means EOF, "0" will give a byte (ascii "0")
445     # to the reading program)
446 dpavlin 1 my ($file) = filename_fixup(shift);
447 dpavlin 8 my ($buf_len,$off) = @_;
448 dpavlin 3
449 dpavlin 1 return -ENOENT() unless exists($files{$file});
450 dpavlin 3
451     my $len = length($files{$file}{cont});
452    
453 dpavlin 8 print "read '$file' [$len bytes] offset $off length $buf_len\n";
454 dpavlin 3
455     return -EINVAL() if ($off > $len);
456     return 0 if ($off == $len);
457    
458 dpavlin 21 $buf_len = $len-$off if ($len - $off < $buf_len);
459 dpavlin 3
460 dpavlin 8 return substr($files{$file}{cont},$off,$buf_len);
461 dpavlin 1 }
462    
463 dpavlin 6 sub clear_cont {
464 dpavlin 7 print "transaction rollback\n";
465     $dbh->rollback || die $dbh->errstr;
466 dpavlin 6 print "invalidate all cached content\n";
467     foreach my $f (keys %files) {
468     delete $files{$f}{cont};
469 dpavlin 31 delete $files{$f}{ctime};
470 dpavlin 6 }
471 dpavlin 7 print "begin new transaction\n";
472 dpavlin 21 #$dbh->begin_work || die $dbh->errstr;
473 dpavlin 6 }
474    
475    
476     sub update_db {
477     my $file = shift || die;
478    
479 dpavlin 8 $files{$file}{ctime} = time();
480    
481 dpavlin 21 my ($cont,$id) = (
482     $files{$file}{cont},
483     $files{$file}{id}
484     );
485    
486     if (!$sth->{'update'}->execute($cont,$id)) {
487 dpavlin 9 print "update problem: ",$sth->{'update'}->errstr;
488 dpavlin 6 clear_cont;
489     return 0;
490     } else {
491 dpavlin 7 if (! $dbh->commit) {
492 dpavlin 9 print "ERROR: commit problem: ",$sth->{'update'}->errstr;
493 dpavlin 6 clear_cont;
494     return 0;
495     }
496     print "updated '$file' [",$files{$file}{id},"]\n";
497 dpavlin 24
498 dpavlin 26 $$fuse_self->{'invalidate'}->() if (ref $$fuse_self->{'invalidate'});
499 dpavlin 6 }
500     return 1;
501     }
502    
503     sub e_write {
504     my $file = filename_fixup(shift);
505 dpavlin 18 my ($buffer,$off) = @_;
506 dpavlin 6
507     return -ENOENT() unless exists($files{$file});
508    
509 dpavlin 18 my $cont = $files{$file}{cont};
510     my $len = length($cont);
511 dpavlin 6
512 dpavlin 18 print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
513 dpavlin 6
514 dpavlin 18 $files{$file}{cont} = "";
515 dpavlin 6
516 dpavlin 18 $files{$file}{cont} .= substr($cont,0,$off) if ($off > 0);
517     $files{$file}{cont} .= $buffer;
518 dpavlin 21 $files{$file}{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);
519 dpavlin 18
520     $files{$file}{size} = length($files{$file}{cont});
521    
522 dpavlin 6 if (! update_db($file)) {
523     return -ENOSYS();
524     } else {
525 dpavlin 18 return length($buffer);
526 dpavlin 6 }
527     }
528    
529     sub e_truncate {
530     my $file = filename_fixup(shift);
531     my $size = shift;
532    
533 dpavlin 18 print "truncate to $size\n";
534    
535 dpavlin 6 $files{$file}{cont} = substr($files{$file}{cont},0,$size);
536 dpavlin 18 $files{$file}{size} = $size;
537 dpavlin 6 return 0
538     };
539    
540    
541     sub e_utime {
542     my ($atime,$mtime,$file) = @_;
543     $file = filename_fixup($file);
544    
545     return -ENOENT() unless exists($files{$file});
546    
547 dpavlin 8 print "utime '$file' $atime $mtime\n";
548    
549 dpavlin 6 $files{$file}{time} = $mtime;
550     return 0;
551     }
552    
553 dpavlin 51 sub e_statfs {
554 dpavlin 1
555 dpavlin 51 my $size = 0;
556     my $inodes = 0;
557    
558     foreach my $f (keys %files) {
559     if ($f !~ /(^|\/)\.\.?$/) {
560     $size += $files{$f}{size} || 0;
561     $inodes++;
562     }
563     print "$inodes: $f [$size]\n";
564     }
565    
566 dpavlin 52 $size = int(($size+BLOCK-1)/BLOCK);
567 dpavlin 51
568 dpavlin 52 my @ret = (255, $inodes, 1, $size, $size-1, BLOCK);
569 dpavlin 51
570 dpavlin 53 #print "statfs: ",join(",",@ret),"\n";
571 dpavlin 51
572     return @ret;
573     }
574    
575 dpavlin 21 sub e_unlink {
576     my $file = filename_fixup(shift);
577    
578 dpavlin 51 # if (exists( $dirs{$file} )) {
579     # print "unlink '$file' will re-read template names\n";
580     # print Dumper($fuse_self);
581     # $$fuse_self->{'read_filenames'}->();
582     # return 0;
583     if (exists( $files{$file} )) {
584 dpavlin 26 print "unlink '$file' will invalidate cache\n";
585     read_content($file,$files{$file}{id});
586     return 0;
587     }
588 dpavlin 21
589 dpavlin 26 return -ENOENT();
590 dpavlin 21 }
591 dpavlin 9 1;
592     __END__
593    
594     =head1 EXPORT
595    
596     Nothing.
597    
598 dpavlin 40 =head1 BUGS
599    
600     Size information (C<ls -s>) is wrong. It's a problem in upstream Fuse module
601     (for which I'm to blame lately), so when it gets fixes, C<Fuse::DBI> will
602     automagically pick it up.
603    
604 dpavlin 9 =head1 SEE ALSO
605    
606     C<FUSE (Filesystem in USErspace)> website
607 dpavlin 36 L<http://fuse.sourceforge.net/>
608 dpavlin 9
609 dpavlin 28 Example for WebGUI which comes with this distribution in
610 dpavlin 30 directory C<examples/webgui.pl>. It also contains a lot of documentation
611 dpavlin 28 about design of this module, usage and limitations.
612    
613 dpavlin 9 =head1 AUTHOR
614    
615     Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
616    
617     =head1 COPYRIGHT AND LICENSE
618    
619     Copyright (C) 2004 by Dobrica Pavlinusic
620    
621     This library is free software; you can redistribute it and/or modify
622     it under the same terms as Perl itself, either Perl version 5.8.4 or,
623     at your option, any later version of Perl 5 you may have available.
624    
625    
626     =cut
627    

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26