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

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26