/[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 61 - (show annotations)
Tue Jan 3 14:56:35 2006 UTC (18 years, 2 months ago) by dpavlin
Original Path: trunk/DBI.pm
File size: 13704 byte(s)
change %files -> $files
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 =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 if ($self->is_mounted) {
254 system "sudo umount ".$self->{'mount'} ||
255 return 0;
256 }
257 return 1;
258 }
259
260 return 0;
261 }
262
263 $SIG{'INT'} = sub {
264 if ($fuse_self && $$fuse_self->umount) {
265 print STDERR "umount called by SIG INT\n";
266 }
267 };
268
269 $SIG{'QUIT'} = sub {
270 if ($fuse_self && $$fuse_self->umount) {
271 print STDERR "umount called by SIG QUIT\n";
272 }
273 };
274
275 sub DESTROY {
276 my $self = shift;
277 if ($self->umount) {
278 print STDERR "umount called by DESTROY\n";
279 }
280 }
281
282 =head2 fuse_module_loaded
283
284 Checks if C<fuse> module is loaded in kernel.
285
286 die "no fuse module loaded in kernel"
287 unless (Fuse::DBI::fuse_module_loaded);
288
289 This function in called by C<mount>, but might be useful alone also.
290
291 =cut
292
293 sub fuse_module_loaded {
294 my $lsmod = `lsmod`;
295 die "can't start lsmod: $!" unless ($lsmod);
296 if ($lsmod =~ m/fuse/s) {
297 return 1;
298 } else {
299 return 0;
300 }
301 }
302
303 my $files;
304
305 sub read_filenames {
306 my $self = shift;
307
308 my $sth = $self->{'sth'} || die "no sth argument";
309
310 # create empty filesystem
311 $files = {
312 '.' => {
313 type => 0040,
314 mode => 0755,
315 },
316 '..' => {
317 type => 0040,
318 mode => 0755,
319 },
320 # a => {
321 # cont => "File 'a'.\n",
322 # type => 0100,
323 # ctime => time()-2000
324 # },
325 };
326
327 # fetch new filename list from database
328 $sth->{'filenames'}->execute() || die $sth->{'filenames'}->errstr();
329
330 # read them in with sesible defaults
331 while (my $row = $sth->{'filenames'}->fetchrow_hashref() ) {
332 $row->{'filename'} ||= 'NULL-'.$row->{'id'};
333 $files->{$row->{'filename'}} = {
334 size => $row->{'size'},
335 mode => $row->{'writable'} ? 0644 : 0444,
336 id => $row->{'id'} || 99,
337 };
338
339
340 my $d;
341 foreach (split(m!/!, $row->{'filename'})) {
342 # first, entry is assumed to be file
343 if ($d) {
344 $files->{$d} = {
345 mode => 0755,
346 type => 0040
347 };
348 $files->{$d.'/.'} = {
349 mode => 0755,
350 type => 0040
351 };
352 $files->{$d.'/..'} = {
353 mode => 0755,
354 type => 0040
355 };
356 }
357 $d .= "/" if ($d);
358 $d .= "$_";
359 }
360 }
361
362 print "found ",scalar(keys %{$files})," files\n";
363 }
364
365
366 sub filename_fixup {
367 my ($file) = shift;
368 $file =~ s,^/,,;
369 $file = '.' unless length($file);
370 return $file;
371 }
372
373 sub e_getattr {
374 my ($file) = filename_fixup(shift);
375 $file =~ s,^/,,;
376 $file = '.' unless length($file);
377 return -ENOENT() unless exists($files->{$file});
378 my ($size) = $files->{$file}->{size} || 0;
379 my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,int(($size+BLOCK-1)/BLOCK),0,0,1,BLOCK);
380 my ($atime, $ctime, $mtime);
381 $atime = $ctime = $mtime = $files->{$file}->{ctime} || $ctime_start;
382
383 my ($modes) = (($files->{$file}->{type} || 0100)<<9) + $files->{$file}->{mode};
384
385 # 2 possible types of return values:
386 #return -ENOENT(); # or any other error you care to
387 #print "getattr($file) ",join(",",($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)),"\n";
388 return ($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
389 }
390
391 sub e_getdir {
392 my ($dirname) = shift;
393 $dirname =~ s!^/!!;
394 # return as many text filenames as you like, followed by the retval.
395 print((scalar keys %{$files})." files total\n");
396 my %out;
397 foreach my $f (sort keys %{$files}) {
398 if ($dirname) {
399 if ($f =~ s/^\Q$dirname\E\///) {
400 $out{$f}++ if ($f =~ /^[^\/]+$/);
401 }
402 } else {
403 $out{$f}++ if ($f =~ /^[^\/]+$/);
404 }
405 }
406 if (! %out) {
407 $out{'no files? bug?'}++;
408 }
409 print scalar keys %out," files in dir '$dirname'\n";
410 print "## ",join(" ",keys %out),"\n";
411 return (keys %out),0;
412 }
413
414 sub read_content {
415 my ($file,$id) = @_;
416
417 die "read_content needs file and id" unless ($file && $id);
418
419 $sth->{'read'}->execute($id) || die $sth->{'read'}->errstr;
420 $files->{$file}->{cont} = $sth->{'read'}->fetchrow_array;
421 # I should modify ctime only if content in database changed
422 #$files->{$file}->{ctime} = time() unless ($files->{$file}->{ctime});
423 print "file '$file' content [",length($files->{$file}->{cont})," bytes] read in cache\n";
424 }
425
426
427 sub e_open {
428 # VFS sanity check; it keeps all the necessary state, not much to do here.
429 my $file = filename_fixup(shift);
430 my $flags = shift;
431
432 return -ENOENT() unless exists($files->{$file});
433 return -EISDIR() unless exists($files->{$file}->{id});
434
435 read_content($file,$files->{$file}->{id}) unless exists($files->{$file}->{cont});
436
437 $files->{$file}->{cont} ||= '';
438 print "open '$file' ",length($files->{$file}->{cont})," bytes\n";
439 return 0;
440 }
441
442 sub e_read {
443 # return an error numeric, or binary/text string.
444 # (note: 0 means EOF, "0" will give a byte (ascii "0")
445 # to the reading program)
446 my ($file) = filename_fixup(shift);
447 my ($buf_len,$off) = @_;
448
449 return -ENOENT() unless exists($files->{$file});
450
451 my $len = length($files->{$file}->{cont});
452
453 print "read '$file' [$len bytes] offset $off length $buf_len\n";
454
455 return -EINVAL() if ($off > $len);
456 return 0 if ($off == $len);
457
458 $buf_len = $len-$off if ($len - $off < $buf_len);
459
460 return substr($files->{$file}->{cont},$off,$buf_len);
461 }
462
463 sub clear_cont {
464 print "transaction rollback\n";
465 $dbh->rollback || die $dbh->errstr;
466 print "invalidate all cached content\n";
467 foreach my $f (keys %{$files}) {
468 delete $files->{$f}->{cont};
469 delete $files->{$f}->{ctime};
470 }
471 print "begin new transaction\n";
472 #$dbh->begin_work || die $dbh->errstr;
473 }
474
475
476 sub update_db {
477 my $file = shift || die;
478
479 $files->{$file}->{ctime} = time();
480
481 my ($cont,$id) = (
482 $files->{$file}->{cont},
483 $files->{$file}->{id}
484 );
485
486 if (!$sth->{'update'}->execute($cont,$id)) {
487 print "update problem: ",$sth->{'update'}->errstr;
488 clear_cont;
489 return 0;
490 } else {
491 if (! $dbh->commit) {
492 print "ERROR: commit problem: ",$sth->{'update'}->errstr;
493 clear_cont;
494 return 0;
495 }
496 print "updated '$file' [",$files->{$file}->{id},"]\n";
497
498 $$fuse_self->{'invalidate'}->() if (ref $$fuse_self->{'invalidate'});
499 }
500 return 1;
501 }
502
503 sub e_write {
504 my $file = filename_fixup(shift);
505 my ($buffer,$off) = @_;
506
507 return -ENOENT() unless exists($files->{$file});
508
509 my $cont = $files->{$file}->{cont};
510 my $len = length($cont);
511
512 print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
513
514 $files->{$file}->{cont} = "";
515
516 $files->{$file}->{cont} .= substr($cont,0,$off) if ($off > 0);
517 $files->{$file}->{cont} .= $buffer;
518 $files->{$file}->{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);
519
520 $files->{$file}->{size} = length($files->{$file}->{cont});
521
522 if (! update_db($file)) {
523 return -ENOSYS();
524 } else {
525 return length($buffer);
526 }
527 }
528
529 sub e_truncate {
530 my $file = filename_fixup(shift);
531 my $size = shift;
532
533 print "truncate to $size\n";
534
535 $files->{$file}->{cont} = substr($files->{$file}->{cont},0,$size);
536 $files->{$file}->{size} = $size;
537 return 0
538 };
539
540
541 sub e_utime {
542 my ($atime,$mtime,$file) = @_;
543 $file = filename_fixup($file);
544
545 return -ENOENT() unless exists($files->{$file});
546
547 print "utime '$file' $atime $mtime\n";
548
549 $files->{$file}->{time} = $mtime;
550 return 0;
551 }
552
553 sub e_statfs {
554
555 my $size = 0;
556 my $inodes = 0;
557
558 foreach my $f (keys %{$files}) {
559 if ($f !~ /(^|\/)\.\.?$/) {
560 $size += $files->{$f}->{size} || 0;
561 $inodes++;
562 }
563 print "$inodes: $f [$size]\n";
564 }
565
566 $size = int(($size+BLOCK-1)/BLOCK);
567
568 my @ret = (255, $inodes, 1, $size, $size-1, BLOCK);
569
570 #print "statfs: ",join(",",@ret),"\n";
571
572 return @ret;
573 }
574
575 sub e_unlink {
576 my $file = filename_fixup(shift);
577
578 # if (exists( $dirs{$file} )) {
579 # print "unlink '$file' will re-read template names\n";
580 # print Dumper($fuse_self);
581 # $$fuse_self->{'read_filenames'}->();
582 # return 0;
583 if (exists( $files->{$file} )) {
584 print "unlink '$file' will invalidate cache\n";
585 read_content($file,$files->{$file}->{id});
586 return 0;
587 }
588
589 return -ENOENT();
590 }
591 1;
592 __END__
593
594 =head1 EXPORT
595
596 Nothing.
597
598 =head1 BUGS
599
600 Size information (C<ls -s>) is wrong. It's a problem in upstream Fuse module
601 (for which I'm to blame lately), so when it gets fixes, C<Fuse::DBI> will
602 automagically pick it up.
603
604 =head1 SEE ALSO
605
606 C<FUSE (Filesystem in USErspace)> website
607 L<http://fuse.sourceforge.net/>
608
609 Example for WebGUI which comes with this distribution in
610 directory C<examples/webgui.pl>. It also contains a lot of documentation
611 about design of this module, usage and limitations.
612
613 =head1 AUTHOR
614
615 Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
616
617 =head1 COPYRIGHT AND LICENSE
618
619 Copyright (C) 2004 by Dobrica Pavlinusic
620
621 This library is free software; you can redistribute it and/or modify
622 it under the same terms as Perl itself, either Perl version 5.8.4 or,
623 at your option, any later version of Perl 5 you may have available.
624
625
626 =cut
627

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26