/[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 47 - (hide annotations)
Tue Nov 23 23:54:58 2004 UTC (19 years, 4 months ago) by dpavlin
File size: 12865 byte(s)
API 0.07:
- added is_mounted
- mount will now block until filesystem is mounted
  (this might take up to 2 sec in intervals of 0.5 sec)

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

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26