/[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 52 - (show 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 #!/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 our $VERSION = '0.07';
16
17 # block size for this filesystem
18 use constant BLOCK => 1024;
19
20 =head1 NAME
21
22 Fuse::DBI - mount your database as filesystem and use it
23
24 =head1 SYNOPSIS
25
26 use Fuse::DBI;
27 Fuse::DBI->mount( ... );
28
29 See C<run> below for examples how to set parameters.
30
31 =head1 DESCRIPTION
32
33 This module will use C<Fuse> module, part of C<FUSE (Filesystem in USErspace)>
34 available at L<http://fuse.sourceforge.net/> to mount
35 your database as file system.
36
37 That will give you possibility to use normal file-system tools (cat, grep, vi)
38 to manipulate data in database.
39
40 It's actually opposite of Oracle's intention to put everything into database.
41
42
43 =head1 METHODS
44
45 =cut
46
47 =head2 mount
48
49 Mount your database as filesystem.
50
51 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 my $mnt = Fuse::DBI->mount({
62 '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 });
70
71 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 =cut
115
116 my $dbh;
117 my $sth;
118 my $ctime_start;
119
120 sub read_filenames;
121 sub fuse_module_loaded;
122
123 # 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 sub mount {
129 my $class = shift;
130 my $self = {};
131 bless($self, $class);
132
133 my $arg = shift;
134
135 print Dumper($arg);
136
137 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 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 # save (some) arguments in self
146 foreach (qw(mount invalidate)) {
147 $self->{$_} = $arg->{$_};
148 }
149
150 foreach (qw(filenames read update)) {
151 carp "mount needs '$_' SQL" unless ($arg->{$_});
152 }
153
154 $ctime_start = time();
155
156 my $pid;
157 if ($arg->{'fork'}) {
158 $pid = fork();
159 die "fork() failed: $!" unless defined $pid;
160 # child will return to caller
161 if ($pid) {
162 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 }
173 }
174
175 $dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, {AutoCommit => 0, RaiseError => 1}) || die $DBI::errstr;
176
177 $sth->{'filenames'} = $dbh->prepare($arg->{'filenames'}) || die $dbh->errstr();
178
179 $sth->{'read'} = $dbh->prepare($arg->{'read'}) || die $dbh->errstr();
180 $sth->{'update'} = $dbh->prepare($arg->{'update'}) || die $dbh->errstr();
181
182
183 $self->{'sth'} = $sth;
184
185 $self->{'read_filenames'} = sub { $self->read_filenames };
186 $self->read_filenames;
187
188 $fuse_self = \$self;
189
190 Fuse::main(
191 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 rmdir=>\&e_unlink,
202 debug=>0,
203 );
204
205 exit(0) if ($arg->{'fork'});
206
207 return 1;
208
209 };
210
211 =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 =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 if ($self->{'mount'} && $self->is_mounted) {
252 system "( fusermount -u ".$self->{'mount'}." 2>&1 ) >/dev/null" ||
253 system "sudo umount ".$self->{'mount'} ||
254 return 0;
255 return 1;
256 }
257
258 return 0;
259 }
260
261 $SIG{'INT'} = sub {
262 if ($fuse_self && $$fuse_self->umount) {
263 print STDERR "umount called by SIG INT\n";
264 }
265 };
266
267 $SIG{'QUIT'} = sub {
268 if ($fuse_self && $$fuse_self->umount) {
269 print STDERR "umount called by SIG QUIT\n";
270 }
271 };
272
273 sub DESTROY {
274 my $self = shift;
275 if ($self->umount) {
276 print STDERR "umount called by DESTROY\n";
277 }
278 }
279
280 =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 This function in called by C<mount>, but might be useful alone also.
288
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 } else {
297 return 0;
298 }
299 }
300
301 my %files;
302
303 sub read_filenames {
304 my $self = shift;
305
306 my $sth = $self->{'sth'} || die "no sth argument";
307
308 # create empty filesystem
309 (%files) = (
310 '.' => {
311 type => 0040,
312 mode => 0755,
313 },
314 '..' => {
315 type => 0040,
316 mode => 0755,
317 },
318 # a => {
319 # cont => "File 'a'.\n",
320 # type => 0100,
321 # ctime => time()-2000
322 # },
323 );
324
325 # 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 }
356 }
357
358 print "found ",scalar(keys %files)," files\n";
359 }
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 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 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 print "getattr($file) ",join(",",($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)),"\n";
384 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 foreach my $f (sort keys %files) {
394 if ($dirname) {
395 if ($f =~ s/^\Q$dirname\E\///) {
396 $out{$f}++ if ($f =~ /^[^\/]+$/);
397 }
398 } else {
399 $out{$f}++ if ($f =~ /^[^\/]+$/);
400 }
401 }
402 if (! %out) {
403 $out{'no files? bug?'}++;
404 }
405 print scalar keys %out," files in dir '$dirname'\n";
406 print "## ",join(" ",keys %out),"\n";
407 return (keys %out),0;
408 }
409
410 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 # I should modify ctime only if content in database changed
418 #$files{$file}{ctime} = time() unless ($files{$file}{ctime});
419 print "file '$file' content [",length($files{$file}{cont})," bytes] read in cache\n";
420 }
421
422
423 sub e_open {
424 # VFS sanity check; it keeps all the necessary state, not much to do here.
425 my $file = filename_fixup(shift);
426 my $flags = shift;
427
428 return -ENOENT() unless exists($files{$file});
429 return -EISDIR() unless exists($files{$file}{id});
430
431 read_content($file,$files{$file}{id}) unless exists($files{$file}{cont});
432
433 print "open '$file' ",length($files{$file}{cont})," bytes\n";
434 return 0;
435 }
436
437 sub e_read {
438 # 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 my ($file) = filename_fixup(shift);
442 my ($buf_len,$off) = @_;
443
444 return -ENOENT() unless exists($files{$file});
445
446 my $len = length($files{$file}{cont});
447
448 print "read '$file' [$len bytes] offset $off length $buf_len\n";
449
450 return -EINVAL() if ($off > $len);
451 return 0 if ($off == $len);
452
453 $buf_len = $len-$off if ($len - $off < $buf_len);
454
455 return substr($files{$file}{cont},$off,$buf_len);
456 }
457
458 sub clear_cont {
459 print "transaction rollback\n";
460 $dbh->rollback || die $dbh->errstr;
461 print "invalidate all cached content\n";
462 foreach my $f (keys %files) {
463 delete $files{$f}{cont};
464 delete $files{$f}{ctime};
465 }
466 print "begin new transaction\n";
467 #$dbh->begin_work || die $dbh->errstr;
468 }
469
470
471 sub update_db {
472 my $file = shift || die;
473
474 $files{$file}{ctime} = time();
475
476 my ($cont,$id) = (
477 $files{$file}{cont},
478 $files{$file}{id}
479 );
480
481 if (!$sth->{'update'}->execute($cont,$id)) {
482 print "update problem: ",$sth->{'update'}->errstr;
483 clear_cont;
484 return 0;
485 } else {
486 if (! $dbh->commit) {
487 print "ERROR: commit problem: ",$sth->{'update'}->errstr;
488 clear_cont;
489 return 0;
490 }
491 print "updated '$file' [",$files{$file}{id},"]\n";
492
493 $$fuse_self->{'invalidate'}->() if (ref $$fuse_self->{'invalidate'});
494 }
495 return 1;
496 }
497
498 sub e_write {
499 my $file = filename_fixup(shift);
500 my ($buffer,$off) = @_;
501
502 return -ENOENT() unless exists($files{$file});
503
504 my $cont = $files{$file}{cont};
505 my $len = length($cont);
506
507 print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
508
509 $files{$file}{cont} = "";
510
511 $files{$file}{cont} .= substr($cont,0,$off) if ($off > 0);
512 $files{$file}{cont} .= $buffer;
513 $files{$file}{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);
514
515 $files{$file}{size} = length($files{$file}{cont});
516
517 if (! update_db($file)) {
518 return -ENOSYS();
519 } else {
520 return length($buffer);
521 }
522 }
523
524 sub e_truncate {
525 my $file = filename_fixup(shift);
526 my $size = shift;
527
528 print "truncate to $size\n";
529
530 $files{$file}{cont} = substr($files{$file}{cont},0,$size);
531 $files{$file}{size} = $size;
532 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 print "utime '$file' $atime $mtime\n";
543
544 $files{$file}{time} = $mtime;
545 return 0;
546 }
547
548 sub e_statfs {
549
550 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 $size = int(($size+BLOCK-1)/BLOCK);
562
563 my @ret = (255, $inodes, 1, $size, $size-1, BLOCK);
564
565 print "statfs: ",join(",",@ret),"\n";
566
567 return @ret;
568 }
569
570 sub e_unlink {
571 my $file = filename_fixup(shift);
572
573 # 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 print "unlink '$file' will invalidate cache\n";
580 read_content($file,$files{$file}{id});
581 return 0;
582 }
583
584 return -ENOENT();
585 }
586 1;
587 __END__
588
589 =head1 EXPORT
590
591 Nothing.
592
593 =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 =head1 SEE ALSO
600
601 C<FUSE (Filesystem in USErspace)> website
602 L<http://fuse.sourceforge.net/>
603
604 Example for WebGUI which comes with this distribution in
605 directory C<examples/webgui.pl>. It also contains a lot of documentation
606 about design of this module, usage and limitations.
607
608 =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