/[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 31 - (show annotations)
Sun Oct 10 19:33:23 2004 UTC (19 years, 5 months ago) by dpavlin
Original Path: trunk/DBI.pm
File size: 11942 byte(s)
modify ctime only when writing to file, prevents message "file has changed"

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

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26