/[fuse_dbi]/fuse-couchdb/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 /fuse-couchdb/DBI.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 68 - (show annotations)
Fri Apr 24 23:43:18 2009 UTC (14 years, 11 months ago) by dpavlin
File size: 15014 byte(s)
Make a branch for Fuse::CouchDB experiment

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.09_1';
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 There is also alternative way which can generate C<read> and C<update>
115 queries on the fly:
116
117 my $mnt = Fuse::DBI->mount({
118 'filenames' => 'select id,filename,size,writable from files',
119 'read' => sub {
120 my ($path,$file) = @_;
121 return( 'select content from files where id = ?', $file->{row}->{id} );
122 },
123 'update' => sub {
124 my ($path,$file) = @_;
125 return( 'update files set content = ? where id = ?', $file->{row}->{id} );
126 },
127 'dsn' => 'DBI:Pg:dbname=test_db',
128 'user' => 'database_user',
129 'password' => 'database_password',
130 'invalidate' => sub { ... },
131 });
132
133 =cut
134
135 my $dbh;
136 my $sth;
137 my $ctime_start;
138
139 sub read_filenames;
140 sub fuse_module_loaded;
141
142 # evil, evil way to solve this. It makes this module non-reentrant. But, since
143 # fuse calls another copy of this script for each mount anyway, this shouldn't
144 # be a problem.
145 my $fuse_self;
146
147 my $debug = 0;
148
149 sub mount {
150 my $class = shift;
151 my $self = {};
152 bless($self, $class);
153
154 my $arg = shift;
155
156 print Dumper($arg);
157
158 unless ($self->fuse_module_loaded) {
159 print STDERR "no fuse module loaded. Trying sudo modprobe fuse!\n";
160 system "sudo modprobe fuse" || die "can't modprobe fuse using sudo!\n";
161 }
162
163 carp "mount needs 'dsn' to connect to (e.g. dsn => 'DBI:Pg:dbname=test')" unless ($arg->{'dsn'});
164 carp "mount needs 'mount' as mountpoint" unless ($arg->{'mount'});
165
166 # save (some) arguments in self
167 foreach (qw(mount invalidate)) {
168 $self->{$_} = $arg->{$_};
169 }
170
171 foreach (qw(filenames read update)) {
172 carp "mount needs '$_' SQL" unless ($arg->{$_});
173 }
174
175 $ctime_start = time();
176
177 my $pid;
178 if ($arg->{'fork'}) {
179 $pid = fork();
180 die "fork() failed: $!" unless defined $pid;
181 # child will return to caller
182 if ($pid) {
183 my $counter = 4;
184 while ($counter && ! $self->is_mounted) {
185 select(undef, undef, undef, 0.5);
186 $counter--;
187 }
188 if ($self->is_mounted) {
189 return $self;
190 } else {
191 return undef;
192 }
193 }
194 }
195
196 $dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, {AutoCommit => 0, RaiseError => 1}) || die $DBI::errstr;
197
198 $sth->{'filenames'} = $dbh->prepare($arg->{'filenames'}) || die $dbh->errstr();
199
200 $self->{'sth'} = $sth;
201 $self->{'dbh'} = $dbh;
202
203 $self->{'read_filenames'} = sub { $self->read_filenames };
204 $self->read_filenames;
205
206 foreach my $op (qw/read update/) {
207 if (ref($arg->{ $op }) ne 'CODE') {
208 $self->{ $op . '_ref' } = sub {
209 my $row = shift;
210 return ($arg->{ $op }, $row->{'id'});
211 }
212 } else {
213 $self->{ $op . '_ref' } = $arg->{ $op };
214 }
215 }
216
217 $fuse_self = $self;
218
219 Fuse::main(
220 mountpoint=>$arg->{'mount'},
221 getattr=>\&e_getattr,
222 getdir=>\&e_getdir,
223 open=>\&e_open,
224 statfs=>\&e_statfs,
225 read=>\&e_read,
226 write=>\&e_write,
227 utime=>\&e_utime,
228 truncate=>\&e_truncate,
229 unlink=>\&e_unlink,
230 rmdir=>\&e_unlink,
231 debug=>$debug,
232 );
233
234 exit(0) if ($arg->{'fork'});
235
236 return 1;
237
238 };
239
240 =head2 is_mounted
241
242 Check if fuse filesystem is mounted
243
244 if ($mnt->is_mounted) { ... }
245
246 =cut
247
248 sub is_mounted {
249 my $self = shift;
250
251 my $mounted = 0;
252 my $mount = $self->{'mount'} || confess "can't find mount point!";
253 if (open(MTAB, "/etc/mtab")) {
254 while(<MTAB>) {
255 $mounted = 1 if (/ $mount fuse /i);
256 }
257 close(MTAB);
258 } else {
259 warn "can't open /etc/mtab: $!";
260 }
261
262 return $mounted;
263 }
264
265
266 =head2 umount
267
268 Unmount your database as filesystem.
269
270 $mnt->umount;
271
272 This will also kill background process which is translating
273 database to filesystem.
274
275 =cut
276
277 sub umount {
278 my $self = shift;
279
280 if ($self->{'mount'} && $self->is_mounted) {
281 system "( fusermount -u ".$self->{'mount'}." 2>&1 ) >/dev/null";
282 sleep 1;
283 if ($self->is_mounted) {
284 system "sudo umount ".$self->{'mount'} ||
285 return 0;
286 }
287 return 1;
288 }
289
290 return 0;
291 }
292
293 $SIG{'INT'} = sub {
294 if ($fuse_self && $fuse_self->can('umount')) {
295 print STDERR "umount called by SIG INT\n";
296 }
297 };
298
299 $SIG{'QUIT'} = sub {
300 if ($fuse_self && $fuse_self->can('umount')) {
301 print STDERR "umount called by SIG QUIT\n";
302 }
303 };
304
305 sub DESTROY {
306 my $self = shift;
307 if ($self->umount) {
308 print STDERR "umount called by DESTROY\n";
309 }
310 }
311
312 =head2 fuse_module_loaded
313
314 Checks if C<fuse> module is loaded in kernel.
315
316 die "no fuse module loaded in kernel"
317 unless (Fuse::DBI::fuse_module_loaded);
318
319 This function in called by C<mount>, but might be useful alone also.
320
321 =cut
322
323 sub fuse_module_loaded {
324 my $lsmod = `lsmod`;
325 die "can't start lsmod: $!" unless ($lsmod);
326 if ($lsmod =~ m/fuse/s) {
327 return 1;
328 } else {
329 return 0;
330 }
331 }
332
333 my $files;
334
335 sub read_filenames {
336 my $self = shift;
337
338 my $sth = $self->{'sth'} || die "no sth argument";
339
340 # create empty filesystem
341 $files = {
342 '.' => {
343 type => 0040,
344 mode => 0755,
345 },
346 '..' => {
347 type => 0040,
348 mode => 0755,
349 },
350 # a => {
351 # cont => "File 'a'.\n",
352 # type => 0100,
353 # ctime => time()-2000
354 # },
355 };
356
357 # fetch new filename list from database
358 $sth->{'filenames'}->execute() || die $sth->{'filenames'}->errstr();
359
360 # read them in with sesible defaults
361 while (my $row = $sth->{'filenames'}->fetchrow_hashref() ) {
362 $row->{'filename'} ||= 'NULL-'.$row->{'id'};
363 $files->{$row->{'filename'}} = {
364 size => $row->{'size'},
365 mode => $row->{'writable'} ? 0644 : 0444,
366 id => $row->{'id'} || undef,
367 row => $row,
368 };
369
370
371 my $d;
372 foreach (split(m!/!, $row->{'filename'})) {
373 # first, entry is assumed to be file
374 if ($d) {
375 $files->{$d} = {
376 mode => 0755,
377 type => 0040
378 };
379 $files->{$d.'/.'} = {
380 mode => 0755,
381 type => 0040
382 };
383 $files->{$d.'/..'} = {
384 mode => 0755,
385 type => 0040
386 };
387 }
388 $d .= "/" if ($d);
389 $d .= "$_";
390 }
391 }
392
393 print "found ",scalar(keys %{$files})," files\n";
394 }
395
396
397 sub filename_fixup {
398 my ($file) = shift;
399 $file =~ s,^/,,;
400 $file = '.' unless length($file);
401 return $file;
402 }
403
404 sub e_getattr {
405 my ($file) = filename_fixup(shift);
406 $file =~ s,^/,,;
407 $file = '.' unless length($file);
408 return -ENOENT() unless exists($files->{$file});
409 my ($size) = $files->{$file}->{size} || 0;
410 my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,int(($size+BLOCK-1)/BLOCK),0,0,1,BLOCK);
411 my ($atime, $ctime, $mtime);
412 $atime = $ctime = $mtime = $files->{$file}->{ctime} || $ctime_start;
413
414 my ($modes) = (($files->{$file}->{type} || 0100)<<9) + $files->{$file}->{mode};
415
416 # 2 possible types of return values:
417 #return -ENOENT(); # or any other error you care to
418 #print "getattr($file) ",join(",",($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)),"\n";
419 return ($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
420 }
421
422 sub e_getdir {
423 my ($dirname) = shift;
424 $dirname =~ s!^/!!;
425 # return as many text filenames as you like, followed by the retval.
426 print((scalar keys %{$files})." files total\n");
427 my %out;
428 foreach my $f (sort keys %{$files}) {
429 if ($dirname) {
430 if ($f =~ s/^\Q$dirname\E\///) {
431 $out{$f}++ if ($f =~ /^[^\/]+$/);
432 }
433 } else {
434 $out{$f}++ if ($f =~ /^[^\/]+$/);
435 }
436 }
437 if (! %out) {
438 $out{'no files? bug?'}++;
439 }
440 print scalar keys %out," files in dir '$dirname'\n";
441 print "## ",join(" ",keys %out),"\n";
442 return (keys %out),0;
443 }
444
445 sub read_content {
446 my $file = shift || die "need file";
447
448 warn "# read_content($file)\n" if ($debug);
449
450 my @args = $fuse_self->{'read_ref'}->($files->{$file});
451 my $sql = shift @args || die "need SQL for $file";
452
453 $fuse_self->{'read_sth'}->{$sql} ||= $fuse_self->{dbh}->prepare($sql) || die $dbh->errstr();
454 my $sth = $fuse_self->{'read_sth'}->{$sql} || die;
455
456 $sth->execute(@args) || die $sth->errstr;
457 $files->{$file}->{cont} = $sth->fetchrow_array;
458 # I should modify ctime only if content in database changed
459 #$files->{$file}->{ctime} = time() unless ($files->{$file}->{ctime});
460 print "file '$file' content [",length($files->{$file}->{cont})," bytes] read in cache\n";
461 }
462
463
464 sub e_open {
465 # VFS sanity check; it keeps all the necessary state, not much to do here.
466 my $file = filename_fixup(shift);
467 my $flags = shift;
468
469 return -ENOENT() unless exists($files->{$file});
470 return -EISDIR() unless exists($files->{$file}->{id});
471
472 read_content($file,$files->{$file}->{id}) unless exists($files->{$file}->{cont});
473
474 $files->{$file}->{cont} ||= '';
475 print "open '$file' ",length($files->{$file}->{cont})," bytes\n";
476 return 0;
477 }
478
479 sub e_read {
480 # return an error numeric, or binary/text string.
481 # (note: 0 means EOF, "0" will give a byte (ascii "0")
482 # to the reading program)
483 my ($file) = filename_fixup(shift);
484 my ($buf_len,$off) = @_;
485
486 return -ENOENT() unless exists($files->{$file});
487
488 my $len = length($files->{$file}->{cont});
489
490 print "read '$file' [$len bytes] offset $off length $buf_len\n";
491
492 return -EINVAL() if ($off > $len);
493 return 0 if ($off == $len);
494
495 $buf_len = $len-$off if ($len - $off < $buf_len);
496
497 return substr($files->{$file}->{cont},$off,$buf_len);
498 }
499
500 sub clear_cont {
501 print "transaction rollback\n";
502 $dbh->rollback || die $dbh->errstr;
503 print "invalidate all cached content\n";
504 foreach my $f (keys %{$files}) {
505 delete $files->{$f}->{cont};
506 delete $files->{$f}->{ctime};
507 }
508 print "begin new transaction\n";
509 #$dbh->begin_work || die $dbh->errstr;
510 }
511
512
513 sub update_db {
514 my $file = shift || die "need file";
515
516 $files->{$file}->{ctime} = time();
517
518 my ($cont,$id) = (
519 $files->{$file}->{cont},
520 $files->{$file}->{id}
521 );
522
523 my @args = $fuse_self->{'update_ref'}->($files->{$file});
524
525 my $sql = shift @args || die "need SQL for $file";
526
527 unshift @args, $files->{$file}->{cont} if ($#args == 0);
528
529 warn "## SQL: $sql\n# files->{$file} = ", Dumper($files->{$file}), $/ if ($debug);
530
531 my $sth = $fuse_self->{'update_sth'}->{$sql}
532 ||= $fuse_self->{dbh}->prepare($sql)
533 || die $dbh->errstr();
534
535 if (!$sth->execute(@args)) {
536 print "update problem: ",$sth->errstr;
537 clear_cont;
538 return 0;
539 } else {
540 if (! $dbh->commit) {
541 print "ERROR: commit problem: ",$sth->errstr;
542 clear_cont;
543 return 0;
544 }
545 print "updated '$file' [",$files->{$file}->{id},"]\n";
546
547 $fuse_self->{'invalidate'}->() if ($fuse_self->can('invalidate'));
548 }
549 return 1;
550 }
551
552 sub e_write {
553 my $file = filename_fixup(shift);
554 my ($buffer,$off) = @_;
555
556 return -ENOENT() unless exists($files->{$file});
557
558 my $cont = $files->{$file}->{cont};
559 my $len = length($cont);
560
561 print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
562
563 $files->{$file}->{cont} = "";
564
565 $files->{$file}->{cont} .= substr($cont,0,$off) if ($off > 0);
566 $files->{$file}->{cont} .= $buffer;
567 $files->{$file}->{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);
568
569 $files->{$file}->{size} = length($files->{$file}->{cont});
570
571 if (! update_db($file)) {
572 return -ENOSYS();
573 } else {
574 return length($buffer);
575 }
576 }
577
578 sub e_truncate {
579 my $file = filename_fixup(shift);
580 my $size = shift;
581
582 print "truncate to $size\n";
583
584 $files->{$file}->{cont} = substr($files->{$file}->{cont},0,$size);
585 $files->{$file}->{size} = $size;
586 return 0
587 };
588
589
590 sub e_utime {
591 my ($atime,$mtime,$file) = @_;
592 $file = filename_fixup($file);
593
594 return -ENOENT() unless exists($files->{$file});
595
596 print "utime '$file' $atime $mtime\n";
597
598 $files->{$file}->{time} = $mtime;
599 return 0;
600 }
601
602 sub e_statfs {
603
604 my $size = 0;
605 my $inodes = 0;
606
607 foreach my $f (keys %{$files}) {
608 if ($f !~ /(^|\/)\.\.?$/) {
609 $size += $files->{$f}->{size} || 0;
610 $inodes++;
611 }
612 print "$inodes: $f [$size]\n";
613 }
614
615 $size = int(($size+BLOCK-1)/BLOCK);
616
617 my @ret = (255, $inodes, 1, $size, $size-1, BLOCK);
618
619 #print "statfs: ",join(",",@ret),"\n";
620
621 return @ret;
622 }
623
624 sub e_unlink {
625 my $file = filename_fixup(shift);
626
627 # if (exists( $dirs{$file} )) {
628 # print "unlink '$file' will re-read template names\n";
629 # print Dumper($fuse_self);
630 # $fuse_self->{'read_filenames'}->();
631 # return 0;
632 if (exists( $files->{$file} )) {
633 print "unlink '$file' will invalidate cache\n";
634 read_content($file,$files->{$file}->{id});
635 return 0;
636 }
637
638 return -ENOENT();
639 }
640 1;
641 __END__
642
643 =head1 EXPORT
644
645 Nothing.
646
647 =head1 BUGS
648
649 Size information (C<ls -s>) is wrong. It's a problem in upstream Fuse module
650 (for which I'm to blame lately), so when it gets fixes, C<Fuse::DBI> will
651 automagically pick it up.
652
653 =head1 SEE ALSO
654
655 C<FUSE (Filesystem in USErspace)> website
656 L<http://fuse.sourceforge.net/>
657
658 Example for WebGUI which comes with this distribution in
659 directory C<examples/webgui.pl>. It also contains a lot of documentation
660 about design of this module, usage and limitations.
661
662 =head1 AUTHOR
663
664 Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
665
666 =head1 COPYRIGHT AND LICENSE
667
668 Copyright (C) 2004 by Dobrica Pavlinusic
669
670 This library is free software; you can redistribute it and/or modify
671 it under the same terms as Perl itself, either Perl version 5.8.4 or,
672 at your option, any later version of Perl 5 you may have available.
673
674
675 =cut
676

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26