/[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 33 - (hide annotations)
Mon Nov 15 20:55:10 2004 UTC (19 years, 4 months ago) by dpavlin
File size: 12003 byte(s)
SQLite test is finally working,
bumped version to 0.05,
you can really umount filesystem when using fork (which is still very
experimental and useful only for tests anyway)

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 33 our $VERSION = '0.05';
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 9 available at L<http://sourceforge.net/projects/avf> to mount
33     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 33 $self->{'mounted'} = 1;
152 dpavlin 22 $pid = fork();
153 dpavlin 21 die "fork() failed: $!" unless defined $pid;
154     # child will return to caller
155     if ($pid) {
156 dpavlin 22 return $self;
157 dpavlin 21 }
158     }
159 dpavlin 9
160 dpavlin 21 $dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, {AutoCommit => 0, RaiseError => 1}) || die $DBI::errstr;
161    
162 dpavlin 26 $sth->{'filenames'} = $dbh->prepare($arg->{'filenames'}) || die $dbh->errstr();
163 dpavlin 9
164     $sth->{'read'} = $dbh->prepare($arg->{'read'}) || die $dbh->errstr();
165     $sth->{'update'} = $dbh->prepare($arg->{'update'}) || die $dbh->errstr();
166    
167 dpavlin 26
168     $self->{'sth'} = $sth;
169    
170     $self->{'read_filenames'} = sub { $self->read_filenames };
171 dpavlin 21 $self->read_filenames;
172 dpavlin 9
173 dpavlin 33 $self->{'mounted'} = 1 unless ($arg->{'fork'});
174 dpavlin 26
175     $fuse_self = \$self;
176    
177 dpavlin 22 Fuse::main(
178 dpavlin 21 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 dpavlin 26 rmdir=>\&e_unlink,
189 dpavlin 21 debug=>0,
190     );
191 dpavlin 26
192     $self->{'mounted'} = 0;
193 dpavlin 9
194 dpavlin 22 exit(0) if ($arg->{'fork'});
195    
196     return 1;
197    
198 dpavlin 9 };
199    
200 dpavlin 11 =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 dpavlin 26 if ($self->{'mounted'}) {
215 dpavlin 33 system "fusermount -u ".$self->{'mount'} || warn "umount error: $!" && return 0;
216 dpavlin 26 }
217 dpavlin 12
218 dpavlin 21 return 1;
219     }
220    
221 dpavlin 26 $SIG{'INT'} = sub {
222     print STDERR "umount called by SIG INT\n";
223     umount;
224     };
225 dpavlin 24
226     sub DESTROY {
227     my $self = shift;
228 dpavlin 26 return if (! $self->{'mounted'});
229 dpavlin 24 print STDERR "umount called by DESTROY\n";
230     $self->umount;
231     }
232    
233 dpavlin 21 =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 dpavlin 28 This function in called by C<mount>, but might be useful alone also.
241 dpavlin 21
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 dpavlin 12 } else {
250 dpavlin 21 return 0;
251 dpavlin 12 }
252 dpavlin 11 }
253    
254 dpavlin 9 my %files;
255 dpavlin 1 my %dirs;
256    
257 dpavlin 9 sub read_filenames {
258 dpavlin 11 my $self = shift;
259    
260 dpavlin 26 my $sth = $self->{'sth'} || die "no sth argument";
261    
262 dpavlin 9 # 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 dpavlin 1
275 dpavlin 9 # 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 dpavlin 1 }
307     }
308 dpavlin 9
309     print "found ",scalar(keys %files)-scalar(keys %dirs)," files, ",scalar(keys %dirs), " dirs\n";
310 dpavlin 1 }
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 dpavlin 13 foreach my $f (sort keys %files) {
345 dpavlin 1 if ($dirname) {
346 dpavlin 32 if ($f =~ s/^\Q$dirname\E\///) {
347 dpavlin 13 $out{$f}++ if ($f =~ /^[^\/]+$/);
348     }
349 dpavlin 1 } else {
350     $out{$f}++ if ($f =~ /^[^\/]+$/);
351     }
352     }
353     if (! %out) {
354     $out{'no files? bug?'}++;
355     }
356 dpavlin 8 print scalar keys %out," files in dir '$dirname'\n";
357 dpavlin 13 print "## ",join(" ",keys %out),"\n";
358 dpavlin 1 return (keys %out),0;
359     }
360    
361 dpavlin 21 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 dpavlin 31 # I should modify ctime only if content in database changed
369     #$files{$file}{ctime} = time() unless ($files{$file}{ctime});
370 dpavlin 21 print "file '$file' content [",length($files{$file}{cont})," bytes] read in cache\n";
371     }
372    
373    
374 dpavlin 1 sub e_open {
375     # VFS sanity check; it keeps all the necessary state, not much to do here.
376 dpavlin 6 my $file = filename_fixup(shift);
377     my $flags = shift;
378    
379 dpavlin 1 return -ENOENT() unless exists($files{$file});
380     return -EISDIR() unless exists($files{$file}{id});
381 dpavlin 6
382 dpavlin 21 read_content($file,$files{$file}{id}) unless exists($files{$file}{cont});
383    
384 dpavlin 3 print "open '$file' ",length($files{$file}{cont})," bytes\n";
385 dpavlin 1 return 0;
386     }
387    
388     sub e_read {
389 dpavlin 3 # 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 dpavlin 1 my ($file) = filename_fixup(shift);
393 dpavlin 8 my ($buf_len,$off) = @_;
394 dpavlin 3
395 dpavlin 1 return -ENOENT() unless exists($files{$file});
396 dpavlin 3
397     my $len = length($files{$file}{cont});
398    
399 dpavlin 8 print "read '$file' [$len bytes] offset $off length $buf_len\n";
400 dpavlin 3
401     return -EINVAL() if ($off > $len);
402     return 0 if ($off == $len);
403    
404 dpavlin 21 $buf_len = $len-$off if ($len - $off < $buf_len);
405 dpavlin 3
406 dpavlin 8 return substr($files{$file}{cont},$off,$buf_len);
407 dpavlin 1 }
408    
409 dpavlin 6 sub clear_cont {
410 dpavlin 7 print "transaction rollback\n";
411     $dbh->rollback || die $dbh->errstr;
412 dpavlin 6 print "invalidate all cached content\n";
413     foreach my $f (keys %files) {
414     delete $files{$f}{cont};
415 dpavlin 31 delete $files{$f}{ctime};
416 dpavlin 6 }
417 dpavlin 7 print "begin new transaction\n";
418 dpavlin 21 #$dbh->begin_work || die $dbh->errstr;
419 dpavlin 6 }
420    
421    
422     sub update_db {
423     my $file = shift || die;
424    
425 dpavlin 8 $files{$file}{ctime} = time();
426    
427 dpavlin 21 my ($cont,$id) = (
428     $files{$file}{cont},
429     $files{$file}{id}
430     );
431    
432     if (!$sth->{'update'}->execute($cont,$id)) {
433 dpavlin 9 print "update problem: ",$sth->{'update'}->errstr;
434 dpavlin 6 clear_cont;
435     return 0;
436     } else {
437 dpavlin 7 if (! $dbh->commit) {
438 dpavlin 9 print "ERROR: commit problem: ",$sth->{'update'}->errstr;
439 dpavlin 6 clear_cont;
440     return 0;
441     }
442     print "updated '$file' [",$files{$file}{id},"]\n";
443 dpavlin 24
444 dpavlin 26 $$fuse_self->{'invalidate'}->() if (ref $$fuse_self->{'invalidate'});
445 dpavlin 6 }
446     return 1;
447     }
448    
449     sub e_write {
450     my $file = filename_fixup(shift);
451 dpavlin 18 my ($buffer,$off) = @_;
452 dpavlin 6
453     return -ENOENT() unless exists($files{$file});
454    
455 dpavlin 18 my $cont = $files{$file}{cont};
456     my $len = length($cont);
457 dpavlin 6
458 dpavlin 18 print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
459 dpavlin 6
460 dpavlin 18 $files{$file}{cont} = "";
461 dpavlin 6
462 dpavlin 18 $files{$file}{cont} .= substr($cont,0,$off) if ($off > 0);
463     $files{$file}{cont} .= $buffer;
464 dpavlin 21 $files{$file}{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);
465 dpavlin 18
466     $files{$file}{size} = length($files{$file}{cont});
467    
468 dpavlin 6 if (! update_db($file)) {
469     return -ENOSYS();
470     } else {
471 dpavlin 18 return length($buffer);
472 dpavlin 6 }
473     }
474    
475     sub e_truncate {
476     my $file = filename_fixup(shift);
477     my $size = shift;
478    
479 dpavlin 18 print "truncate to $size\n";
480    
481 dpavlin 6 $files{$file}{cont} = substr($files{$file}{cont},0,$size);
482 dpavlin 18 $files{$file}{size} = $size;
483 dpavlin 6 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 dpavlin 8 print "utime '$file' $atime $mtime\n";
494    
495 dpavlin 6 $files{$file}{time} = $mtime;
496     return 0;
497     }
498    
499 dpavlin 1 sub e_statfs { return 255, 1, 1, 1, 1, 2 }
500    
501 dpavlin 21 sub e_unlink {
502     my $file = filename_fixup(shift);
503    
504 dpavlin 26 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 dpavlin 21
515 dpavlin 26 return -ENOENT();
516 dpavlin 21 }
517 dpavlin 9 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 dpavlin 28 Example for WebGUI which comes with this distribution in
530 dpavlin 30 directory C<examples/webgui.pl>. It also contains a lot of documentation
531 dpavlin 28 about design of this module, usage and limitations.
532    
533 dpavlin 9 =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    

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26