/[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 30 - (show annotations)
Sat Oct 9 00:03:42 2004 UTC (19 years, 5 months ago) by dpavlin
Original Path: trunk/DBI.pm
File size: 11822 byte(s)
fix for pod2html

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 $files{$file}{ctime} = time();
368 print "file '$file' content [",length($files{$file}{cont})," bytes] read in cache\n";
369 }
370
371
372 sub e_open {
373 # VFS sanity check; it keeps all the necessary state, not much to do here.
374 my $file = filename_fixup(shift);
375 my $flags = shift;
376
377 return -ENOENT() unless exists($files{$file});
378 return -EISDIR() unless exists($files{$file}{id});
379
380 read_content($file,$files{$file}{id}) unless exists($files{$file}{cont});
381
382 print "open '$file' ",length($files{$file}{cont})," bytes\n";
383 return 0;
384 }
385
386 sub e_read {
387 # return an error numeric, or binary/text string.
388 # (note: 0 means EOF, "0" will give a byte (ascii "0")
389 # to the reading program)
390 my ($file) = filename_fixup(shift);
391 my ($buf_len,$off) = @_;
392
393 return -ENOENT() unless exists($files{$file});
394
395 my $len = length($files{$file}{cont});
396
397 print "read '$file' [$len bytes] offset $off length $buf_len\n";
398
399 return -EINVAL() if ($off > $len);
400 return 0 if ($off == $len);
401
402 $buf_len = $len-$off if ($len - $off < $buf_len);
403
404 return substr($files{$file}{cont},$off,$buf_len);
405 }
406
407 sub clear_cont {
408 print "transaction rollback\n";
409 $dbh->rollback || die $dbh->errstr;
410 print "invalidate all cached content\n";
411 foreach my $f (keys %files) {
412 delete $files{$f}{cont};
413 }
414 print "begin new transaction\n";
415 #$dbh->begin_work || die $dbh->errstr;
416 }
417
418
419 sub update_db {
420 my $file = shift || die;
421
422 $files{$file}{ctime} = time();
423
424 my ($cont,$id) = (
425 $files{$file}{cont},
426 $files{$file}{id}
427 );
428
429 if (!$sth->{'update'}->execute($cont,$id)) {
430 print "update problem: ",$sth->{'update'}->errstr;
431 clear_cont;
432 return 0;
433 } else {
434 if (! $dbh->commit) {
435 print "ERROR: commit problem: ",$sth->{'update'}->errstr;
436 clear_cont;
437 return 0;
438 }
439 print "updated '$file' [",$files{$file}{id},"]\n";
440
441 $$fuse_self->{'invalidate'}->() if (ref $$fuse_self->{'invalidate'});
442 }
443 return 1;
444 }
445
446 sub e_write {
447 my $file = filename_fixup(shift);
448 my ($buffer,$off) = @_;
449
450 return -ENOENT() unless exists($files{$file});
451
452 my $cont = $files{$file}{cont};
453 my $len = length($cont);
454
455 print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
456
457 $files{$file}{cont} = "";
458
459 $files{$file}{cont} .= substr($cont,0,$off) if ($off > 0);
460 $files{$file}{cont} .= $buffer;
461 $files{$file}{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);
462
463 $files{$file}{size} = length($files{$file}{cont});
464
465 if (! update_db($file)) {
466 return -ENOSYS();
467 } else {
468 return length($buffer);
469 }
470 }
471
472 sub e_truncate {
473 my $file = filename_fixup(shift);
474 my $size = shift;
475
476 print "truncate to $size\n";
477
478 $files{$file}{cont} = substr($files{$file}{cont},0,$size);
479 $files{$file}{size} = $size;
480 return 0
481 };
482
483
484 sub e_utime {
485 my ($atime,$mtime,$file) = @_;
486 $file = filename_fixup($file);
487
488 return -ENOENT() unless exists($files{$file});
489
490 print "utime '$file' $atime $mtime\n";
491
492 $files{$file}{time} = $mtime;
493 return 0;
494 }
495
496 sub e_statfs { return 255, 1, 1, 1, 1, 2 }
497
498 sub e_unlink {
499 my $file = filename_fixup(shift);
500
501 if (exists( $dirs{$file} )) {
502 print "unlink '$file' will re-read template names\n";
503 print Dumper($fuse_self);
504 $$fuse_self->{'read_filenames'}->();
505 return 0;
506 } elsif (exists( $files{$file} )) {
507 print "unlink '$file' will invalidate cache\n";
508 read_content($file,$files{$file}{id});
509 return 0;
510 }
511
512 return -ENOENT();
513 }
514 1;
515 __END__
516
517 =head1 EXPORT
518
519 Nothing.
520
521 =head1 SEE ALSO
522
523 C<FUSE (Filesystem in USErspace)> website
524 L<http://sourceforge.net/projects/avf>
525
526 Example for WebGUI which comes with this distribution in
527 directory C<examples/webgui.pl>. It also contains a lot of documentation
528 about design of this module, usage and limitations.
529
530 =head1 AUTHOR
531
532 Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
533
534 =head1 COPYRIGHT AND LICENSE
535
536 Copyright (C) 2004 by Dobrica Pavlinusic
537
538 This library is free software; you can redistribute it and/or modify
539 it under the same terms as Perl itself, either Perl version 5.8.4 or,
540 at your option, any later version of Perl 5 you may have available.
541
542
543 =cut
544

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26