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

Contents of /trunk/DBI.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 40 - (show annotations)
Fri Nov 19 21:56:12 2004 UTC (19 years, 3 months ago) by dpavlin
File size: 12509 byte(s)
fixed mounted mess. This will probably fix fusermount errors users are
seeing once and forever. Added $SIG{'QUIT'} handler, documented bug in
upstream Fuse module.

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

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26