/[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 47 - (show annotations)
Tue Nov 23 23:54:58 2004 UTC (19 years, 4 months ago) by dpavlin
File size: 12865 byte(s)
API 0.07:
- added is_mounted
- mount will now block until filesystem is mounted
  (this might take up to 2 sec in intervals of 0.5 sec)

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

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26