/[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

Annotation of /trunk/DBI.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 31 - (hide annotations)
Sun Oct 10 19:33:23 2004 UTC (19 years, 5 months ago) by dpavlin
File size: 11942 byte(s)
modify ctime only when writing to file, prevents message "file has changed"

1 dpavlin 1 #!/usr/bin/perl
2    
3 dpavlin 9 package Fuse::DBI;
4    
5     use 5.008;
6     use strict;
7     use warnings;
8    
9 dpavlin 7 use POSIX qw(ENOENT EISDIR EINVAL ENOSYS O_RDWR);
10 dpavlin 1 use Fuse;
11     use DBI;
12 dpavlin 11 use Carp;
13     use Data::Dumper;
14 dpavlin 1
15 dpavlin 11
16 dpavlin 28 our $VERSION = '0.04';
17 dpavlin 1
18 dpavlin 9 =head1 NAME
19 dpavlin 1
20 dpavlin 9 Fuse::DBI - mount your database as filesystem and use it
21 dpavlin 1
22 dpavlin 9 =head1 SYNOPSIS
23 dpavlin 6
24 dpavlin 9 use Fuse::DBI;
25 dpavlin 11 Fuse::DBI->mount( ... );
26 dpavlin 1
27 dpavlin 28 See C<run> below for examples how to set parameters.
28 dpavlin 1
29 dpavlin 9 =head1 DESCRIPTION
30 dpavlin 1
31 dpavlin 23 This module will use C<Fuse> module, part of C<FUSE (Filesystem in USErspace)>
32 dpavlin 9 available at L<http://sourceforge.net/projects/avf> to mount
33     your database as file system.
34 dpavlin 1
35 dpavlin 28 That will give you possibility to use normal file-system tools (cat, grep, vi)
36 dpavlin 9 to manipulate data in database.
37 dpavlin 1
38 dpavlin 9 It's actually opposite of Oracle's intention to put everything into database.
39 dpavlin 1
40    
41 dpavlin 9 =head1 METHODS
42    
43     =cut
44    
45 dpavlin 11 =head2 mount
46 dpavlin 9
47     Mount your database as filesystem.
48    
49 dpavlin 28 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 dpavlin 11 my $mnt = Fuse::DBI->mount({
60 dpavlin 28 '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 dpavlin 9 });
68    
69 dpavlin 28 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 dpavlin 9 =cut
113    
114     my $dbh;
115     my $sth;
116     my $ctime_start;
117    
118 dpavlin 11 sub read_filenames;
119 dpavlin 21 sub fuse_module_loaded;
120 dpavlin 9
121 dpavlin 24 # 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 dpavlin 11 sub mount {
127     my $class = shift;
128     my $self = {};
129     bless($self, $class);
130 dpavlin 9
131 dpavlin 11 my $arg = shift;
132 dpavlin 9
133 dpavlin 11 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 dpavlin 12 # save (some) arguments in self
139 dpavlin 24 foreach (qw(mount invalidate)) {
140     $self->{$_} = $arg->{$_};
141     }
142 dpavlin 12
143 dpavlin 9 foreach (qw(filenames read update)) {
144 dpavlin 11 carp "mount needs '$_' SQL" unless ($arg->{$_});
145 dpavlin 9 }
146    
147 dpavlin 21 $ctime_start = time();
148 dpavlin 9
149 dpavlin 22 my $pid;
150 dpavlin 21 if ($arg->{'fork'}) {
151 dpavlin 22 $pid = fork();
152 dpavlin 21 die "fork() failed: $!" unless defined $pid;
153     # child will return to caller
154     if ($pid) {
155 dpavlin 22 return $self;
156 dpavlin 21 }
157     }
158 dpavlin 9
159 dpavlin 21 $dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, {AutoCommit => 0, RaiseError => 1}) || die $DBI::errstr;
160    
161 dpavlin 26 $sth->{'filenames'} = $dbh->prepare($arg->{'filenames'}) || die $dbh->errstr();
162 dpavlin 9
163     $sth->{'read'} = $dbh->prepare($arg->{'read'}) || die $dbh->errstr();
164     $sth->{'update'} = $dbh->prepare($arg->{'update'}) || die $dbh->errstr();
165    
166 dpavlin 26
167     $self->{'sth'} = $sth;
168    
169     $self->{'read_filenames'} = sub { $self->read_filenames };
170 dpavlin 21 $self->read_filenames;
171 dpavlin 9
172 dpavlin 26 $self->{'mounted'} = 1;
173    
174     $fuse_self = \$self;
175    
176 dpavlin 22 Fuse::main(
177 dpavlin 21 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 dpavlin 26 rmdir=>\&e_unlink,
188 dpavlin 21 debug=>0,
189     );
190 dpavlin 26
191     $self->{'mounted'} = 0;
192 dpavlin 9
193 dpavlin 22 exit(0) if ($arg->{'fork'});
194    
195     return 1;
196    
197 dpavlin 9 };
198    
199 dpavlin 11 =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 dpavlin 26 if ($self->{'mounted'}) {
214     system "fusermount -u ".$self->{'mount'} || croak "umount error: $!";
215     }
216 dpavlin 12
217 dpavlin 21 return 1;
218     }
219    
220 dpavlin 26 $SIG{'INT'} = sub {
221     print STDERR "umount called by SIG INT\n";
222     umount;
223     };
224 dpavlin 24
225     sub DESTROY {
226     my $self = shift;
227 dpavlin 26 return if (! $self->{'mounted'});
228 dpavlin 24 print STDERR "umount called by DESTROY\n";
229     $self->umount;
230     }
231    
232 dpavlin 21 =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 dpavlin 28 This function in called by C<mount>, but might be useful alone also.
240 dpavlin 21
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 dpavlin 12 } else {
249 dpavlin 21 return 0;
250 dpavlin 12 }
251 dpavlin 11 }
252    
253 dpavlin 9 my %files;
254 dpavlin 1 my %dirs;
255    
256 dpavlin 9 sub read_filenames {
257 dpavlin 11 my $self = shift;
258    
259 dpavlin 26 my $sth = $self->{'sth'} || die "no sth argument";
260    
261 dpavlin 9 # 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 dpavlin 1
274 dpavlin 9 # 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 dpavlin 1 }
306     }
307 dpavlin 9
308     print "found ",scalar(keys %files)-scalar(keys %dirs)," files, ",scalar(keys %dirs), " dirs\n";
309 dpavlin 1 }
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 dpavlin 13 foreach my $f (sort keys %files) {
344 dpavlin 1 if ($dirname) {
345 dpavlin 13 if ($f =~ s/^\E$dirname\Q\///) {
346     $out{$f}++ if ($f =~ /^[^\/]+$/);
347     }
348 dpavlin 1 } else {
349     $out{$f}++ if ($f =~ /^[^\/]+$/);
350     }
351     }
352     if (! %out) {
353     $out{'no files? bug?'}++;
354     }
355 dpavlin 8 print scalar keys %out," files in dir '$dirname'\n";
356 dpavlin 13 print "## ",join(" ",keys %out),"\n";
357 dpavlin 1 return (keys %out),0;
358     }
359    
360 dpavlin 21 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 dpavlin 31 # I should modify ctime only if content in database changed
368     #$files{$file}{ctime} = time() unless ($files{$file}{ctime});
369 dpavlin 21 print "file '$file' content [",length($files{$file}{cont})," bytes] read in cache\n";
370     }
371    
372    
373 dpavlin 1 sub e_open {
374     # VFS sanity check; it keeps all the necessary state, not much to do here.
375 dpavlin 6 my $file = filename_fixup(shift);
376     my $flags = shift;
377    
378 dpavlin 1 return -ENOENT() unless exists($files{$file});
379     return -EISDIR() unless exists($files{$file}{id});
380 dpavlin 6
381 dpavlin 21 read_content($file,$files{$file}{id}) unless exists($files{$file}{cont});
382    
383 dpavlin 3 print "open '$file' ",length($files{$file}{cont})," bytes\n";
384 dpavlin 1 return 0;
385     }
386    
387     sub e_read {
388 dpavlin 3 # 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 dpavlin 1 my ($file) = filename_fixup(shift);
392 dpavlin 8 my ($buf_len,$off) = @_;
393 dpavlin 3
394 dpavlin 1 return -ENOENT() unless exists($files{$file});
395 dpavlin 3
396     my $len = length($files{$file}{cont});
397    
398 dpavlin 8 print "read '$file' [$len bytes] offset $off length $buf_len\n";
399 dpavlin 3
400     return -EINVAL() if ($off > $len);
401     return 0 if ($off == $len);
402    
403 dpavlin 21 $buf_len = $len-$off if ($len - $off < $buf_len);
404 dpavlin 3
405 dpavlin 8 return substr($files{$file}{cont},$off,$buf_len);
406 dpavlin 1 }
407    
408 dpavlin 6 sub clear_cont {
409 dpavlin 7 print "transaction rollback\n";
410     $dbh->rollback || die $dbh->errstr;
411 dpavlin 6 print "invalidate all cached content\n";
412     foreach my $f (keys %files) {
413     delete $files{$f}{cont};
414 dpavlin 31 delete $files{$f}{ctime};
415 dpavlin 6 }
416 dpavlin 7 print "begin new transaction\n";
417 dpavlin 21 #$dbh->begin_work || die $dbh->errstr;
418 dpavlin 6 }
419    
420    
421     sub update_db {
422     my $file = shift || die;
423    
424 dpavlin 8 $files{$file}{ctime} = time();
425    
426 dpavlin 21 my ($cont,$id) = (
427     $files{$file}{cont},
428     $files{$file}{id}
429     );
430    
431     if (!$sth->{'update'}->execute($cont,$id)) {
432 dpavlin 9 print "update problem: ",$sth->{'update'}->errstr;
433 dpavlin 6 clear_cont;
434     return 0;
435     } else {
436 dpavlin 7 if (! $dbh->commit) {
437 dpavlin 9 print "ERROR: commit problem: ",$sth->{'update'}->errstr;
438 dpavlin 6 clear_cont;
439     return 0;
440     }
441     print "updated '$file' [",$files{$file}{id},"]\n";
442 dpavlin 24
443 dpavlin 26 $$fuse_self->{'invalidate'}->() if (ref $$fuse_self->{'invalidate'});
444 dpavlin 6 }
445     return 1;
446     }
447    
448     sub e_write {
449     my $file = filename_fixup(shift);
450 dpavlin 18 my ($buffer,$off) = @_;
451 dpavlin 6
452     return -ENOENT() unless exists($files{$file});
453    
454 dpavlin 18 my $cont = $files{$file}{cont};
455     my $len = length($cont);
456 dpavlin 6
457 dpavlin 18 print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
458 dpavlin 6
459 dpavlin 18 $files{$file}{cont} = "";
460 dpavlin 6
461 dpavlin 18 $files{$file}{cont} .= substr($cont,0,$off) if ($off > 0);
462     $files{$file}{cont} .= $buffer;
463 dpavlin 21 $files{$file}{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);
464 dpavlin 18
465     $files{$file}{size} = length($files{$file}{cont});
466    
467 dpavlin 6 if (! update_db($file)) {
468     return -ENOSYS();
469     } else {
470 dpavlin 18 return length($buffer);
471 dpavlin 6 }
472     }
473    
474     sub e_truncate {
475     my $file = filename_fixup(shift);
476     my $size = shift;
477    
478 dpavlin 18 print "truncate to $size\n";
479    
480 dpavlin 6 $files{$file}{cont} = substr($files{$file}{cont},0,$size);
481 dpavlin 18 $files{$file}{size} = $size;
482 dpavlin 6 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 dpavlin 8 print "utime '$file' $atime $mtime\n";
493    
494 dpavlin 6 $files{$file}{time} = $mtime;
495     return 0;
496     }
497    
498 dpavlin 1 sub e_statfs { return 255, 1, 1, 1, 1, 2 }
499    
500 dpavlin 21 sub e_unlink {
501     my $file = filename_fixup(shift);
502    
503 dpavlin 26 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 dpavlin 21
514 dpavlin 26 return -ENOENT();
515 dpavlin 21 }
516 dpavlin 9 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 dpavlin 28 Example for WebGUI which comes with this distribution in
529 dpavlin 30 directory C<examples/webgui.pl>. It also contains a lot of documentation
530 dpavlin 28 about design of this module, usage and limitations.
531    
532 dpavlin 9 =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