/[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 26 - (hide annotations)
Fri Oct 8 22:55:36 2004 UTC (19 years, 5 months ago) by dpavlin
File size: 10412 byte(s)
added invalidation of file list with rmdir,
prevent multiple umounts by keeping mounted flag

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 21 our $VERSION = '0.03';
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 23 See C<run> below for examples how to set parametars.
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 9 That will give you posibility to use normal file-system tools (cat, grep, vi)
36     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 11 my $mnt = Fuse::DBI->mount({
50 dpavlin 21 filenames => 'select name from files_table as filenames',
51 dpavlin 9 read => 'sql read',
52     update => 'sql update',
53     dsn => 'DBI:Pg:dbname=webgui',
54     user => 'database_user',
55     password => 'database_password'
56     });
57    
58     =cut
59    
60     my $dbh;
61     my $sth;
62     my $ctime_start;
63    
64 dpavlin 11 sub read_filenames;
65 dpavlin 21 sub fuse_module_loaded;
66 dpavlin 9
67 dpavlin 24 # evil, evil way to solve this. It makes this module non-reentrant. But, since
68     # fuse calls another copy of this script for each mount anyway, this shouldn't
69     # be a problem.
70     my $fuse_self;
71    
72 dpavlin 11 sub mount {
73     my $class = shift;
74     my $self = {};
75     bless($self, $class);
76 dpavlin 9
77 dpavlin 11 my $arg = shift;
78 dpavlin 9
79 dpavlin 11 print Dumper($arg);
80    
81     carp "mount needs 'dsn' to connect to (e.g. dsn => 'DBI:Pg:dbname=test')" unless ($arg->{'dsn'});
82     carp "mount needs 'mount' as mountpoint" unless ($arg->{'mount'});
83    
84 dpavlin 12 # save (some) arguments in self
85 dpavlin 24 foreach (qw(mount invalidate)) {
86     $self->{$_} = $arg->{$_};
87     }
88 dpavlin 12
89 dpavlin 9 foreach (qw(filenames read update)) {
90 dpavlin 11 carp "mount needs '$_' SQL" unless ($arg->{$_});
91 dpavlin 9 }
92    
93 dpavlin 21 $ctime_start = time();
94 dpavlin 9
95 dpavlin 22 my $pid;
96 dpavlin 21 if ($arg->{'fork'}) {
97 dpavlin 22 $pid = fork();
98 dpavlin 21 die "fork() failed: $!" unless defined $pid;
99     # child will return to caller
100     if ($pid) {
101 dpavlin 22 return $self;
102 dpavlin 21 }
103     }
104 dpavlin 9
105 dpavlin 21 $dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, {AutoCommit => 0, RaiseError => 1}) || die $DBI::errstr;
106    
107 dpavlin 26 $sth->{'filenames'} = $dbh->prepare($arg->{'filenames'}) || die $dbh->errstr();
108 dpavlin 9
109     $sth->{'read'} = $dbh->prepare($arg->{'read'}) || die $dbh->errstr();
110     $sth->{'update'} = $dbh->prepare($arg->{'update'}) || die $dbh->errstr();
111    
112 dpavlin 26
113     $self->{'sth'} = $sth;
114    
115     $self->{'read_filenames'} = sub { $self->read_filenames };
116 dpavlin 21 $self->read_filenames;
117 dpavlin 9
118 dpavlin 26 $self->{'mounted'} = 1;
119    
120     $fuse_self = \$self;
121    
122 dpavlin 22 Fuse::main(
123 dpavlin 21 mountpoint=>$arg->{'mount'},
124     getattr=>\&e_getattr,
125     getdir=>\&e_getdir,
126     open=>\&e_open,
127     statfs=>\&e_statfs,
128     read=>\&e_read,
129     write=>\&e_write,
130     utime=>\&e_utime,
131     truncate=>\&e_truncate,
132     unlink=>\&e_unlink,
133 dpavlin 26 rmdir=>\&e_unlink,
134 dpavlin 21 debug=>0,
135     );
136 dpavlin 26
137     $self->{'mounted'} = 0;
138 dpavlin 9
139 dpavlin 22 exit(0) if ($arg->{'fork'});
140    
141     return 1;
142    
143 dpavlin 9 };
144    
145 dpavlin 11 =head2 umount
146    
147     Unmount your database as filesystem.
148    
149     $mnt->umount;
150    
151     This will also kill background process which is translating
152     database to filesystem.
153    
154     =cut
155    
156     sub umount {
157     my $self = shift;
158    
159 dpavlin 26 if ($self->{'mounted'}) {
160     system "fusermount -u ".$self->{'mount'} || croak "umount error: $!";
161     }
162 dpavlin 12
163 dpavlin 21 return 1;
164     }
165    
166 dpavlin 26 $SIG{'INT'} = sub {
167     print STDERR "umount called by SIG INT\n";
168     umount;
169     };
170 dpavlin 24
171     sub DESTROY {
172     my $self = shift;
173 dpavlin 26 return if (! $self->{'mounted'});
174 dpavlin 24 print STDERR "umount called by DESTROY\n";
175     $self->umount;
176     }
177    
178 dpavlin 21 =head2 fuse_module_loaded
179    
180     Checks if C<fuse> module is loaded in kernel.
181    
182     die "no fuse module loaded in kernel"
183     unless (Fuse::DBI::fuse_module_loaded);
184    
185     This function in called by L<mount>, but might be useful alone also.
186    
187     =cut
188    
189     sub fuse_module_loaded {
190     my $lsmod = `lsmod`;
191     die "can't start lsmod: $!" unless ($lsmod);
192     if ($lsmod =~ m/fuse/s) {
193     return 1;
194 dpavlin 12 } else {
195 dpavlin 21 return 0;
196 dpavlin 12 }
197 dpavlin 11 }
198    
199 dpavlin 9 my %files;
200 dpavlin 1 my %dirs;
201    
202 dpavlin 9 sub read_filenames {
203 dpavlin 11 my $self = shift;
204    
205 dpavlin 26 my $sth = $self->{'sth'} || die "no sth argument";
206    
207 dpavlin 9 # create empty filesystem
208     (%files) = (
209     '.' => {
210     type => 0040,
211     mode => 0755,
212     },
213     # a => {
214     # cont => "File 'a'.\n",
215     # type => 0100,
216     # ctime => time()-2000
217     # },
218     );
219 dpavlin 1
220 dpavlin 9 # fetch new filename list from database
221     $sth->{'filenames'}->execute() || die $sth->{'filenames'}->errstr();
222    
223     # read them in with sesible defaults
224     while (my $row = $sth->{'filenames'}->fetchrow_hashref() ) {
225     $files{$row->{'filename'}} = {
226     size => $row->{'size'},
227     mode => $row->{'writable'} ? 0644 : 0444,
228     id => $row->{'id'} || 99,
229     };
230    
231     my $d;
232     foreach (split(m!/!, $row->{'filename'})) {
233     # first, entry is assumed to be file
234     if ($d) {
235     $files{$d} = {
236     size => $dirs{$d}++,
237     mode => 0755,
238     type => 0040
239     };
240     $files{$d.'/.'} = {
241     mode => 0755,
242     type => 0040
243     };
244     $files{$d.'/..'} = {
245     mode => 0755,
246     type => 0040
247     };
248     }
249     $d .= "/" if ($d);
250     $d .= "$_";
251 dpavlin 1 }
252     }
253 dpavlin 9
254     print "found ",scalar(keys %files)-scalar(keys %dirs)," files, ",scalar(keys %dirs), " dirs\n";
255 dpavlin 1 }
256    
257    
258     sub filename_fixup {
259     my ($file) = shift;
260     $file =~ s,^/,,;
261     $file = '.' unless length($file);
262     return $file;
263     }
264    
265     sub e_getattr {
266     my ($file) = filename_fixup(shift);
267     $file =~ s,^/,,;
268     $file = '.' unless length($file);
269     return -ENOENT() unless exists($files{$file});
270     my ($size) = $files{$file}{size} || 1;
271     my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,1,0,0,1,1024);
272     my ($atime, $ctime, $mtime);
273     $atime = $ctime = $mtime = $files{$file}{ctime} || $ctime_start;
274    
275     my ($modes) = (($files{$file}{type} || 0100)<<9) + $files{$file}{mode};
276    
277     # 2 possible types of return values:
278     #return -ENOENT(); # or any other error you care to
279     #print(join(",",($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)),"\n");
280     return ($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
281     }
282    
283     sub e_getdir {
284     my ($dirname) = shift;
285     $dirname =~ s!^/!!;
286     # return as many text filenames as you like, followed by the retval.
287     print((scalar keys %files)." files total\n");
288     my %out;
289 dpavlin 13 foreach my $f (sort keys %files) {
290 dpavlin 1 if ($dirname) {
291 dpavlin 13 if ($f =~ s/^\E$dirname\Q\///) {
292     $out{$f}++ if ($f =~ /^[^\/]+$/);
293     }
294 dpavlin 1 } else {
295     $out{$f}++ if ($f =~ /^[^\/]+$/);
296     }
297     }
298     if (! %out) {
299     $out{'no files? bug?'}++;
300     }
301 dpavlin 8 print scalar keys %out," files in dir '$dirname'\n";
302 dpavlin 13 print "## ",join(" ",keys %out),"\n";
303 dpavlin 1 return (keys %out),0;
304     }
305    
306 dpavlin 21 sub read_content {
307     my ($file,$id) = @_;
308    
309     die "read_content needs file and id" unless ($file && $id);
310    
311     $sth->{'read'}->execute($id) || die $sth->{'read'}->errstr;
312     $files{$file}{cont} = $sth->{'read'}->fetchrow_array;
313 dpavlin 26 $files{$file}{ctime} = time();
314 dpavlin 21 print "file '$file' content [",length($files{$file}{cont})," bytes] read in cache\n";
315     }
316    
317    
318 dpavlin 1 sub e_open {
319     # VFS sanity check; it keeps all the necessary state, not much to do here.
320 dpavlin 6 my $file = filename_fixup(shift);
321     my $flags = shift;
322    
323 dpavlin 1 return -ENOENT() unless exists($files{$file});
324     return -EISDIR() unless exists($files{$file}{id});
325 dpavlin 6
326 dpavlin 21 read_content($file,$files{$file}{id}) unless exists($files{$file}{cont});
327    
328 dpavlin 3 print "open '$file' ",length($files{$file}{cont})," bytes\n";
329 dpavlin 1 return 0;
330     }
331    
332     sub e_read {
333 dpavlin 3 # return an error numeric, or binary/text string.
334     # (note: 0 means EOF, "0" will give a byte (ascii "0")
335     # to the reading program)
336 dpavlin 1 my ($file) = filename_fixup(shift);
337 dpavlin 8 my ($buf_len,$off) = @_;
338 dpavlin 3
339 dpavlin 1 return -ENOENT() unless exists($files{$file});
340 dpavlin 3
341     my $len = length($files{$file}{cont});
342    
343 dpavlin 8 print "read '$file' [$len bytes] offset $off length $buf_len\n";
344 dpavlin 3
345     return -EINVAL() if ($off > $len);
346     return 0 if ($off == $len);
347    
348 dpavlin 21 $buf_len = $len-$off if ($len - $off < $buf_len);
349 dpavlin 3
350 dpavlin 8 return substr($files{$file}{cont},$off,$buf_len);
351 dpavlin 1 }
352    
353 dpavlin 6 sub clear_cont {
354 dpavlin 7 print "transaction rollback\n";
355     $dbh->rollback || die $dbh->errstr;
356 dpavlin 6 print "invalidate all cached content\n";
357     foreach my $f (keys %files) {
358     delete $files{$f}{cont};
359     }
360 dpavlin 7 print "begin new transaction\n";
361 dpavlin 21 #$dbh->begin_work || die $dbh->errstr;
362 dpavlin 6 }
363    
364    
365     sub update_db {
366     my $file = shift || die;
367    
368 dpavlin 8 $files{$file}{ctime} = time();
369    
370 dpavlin 21 my ($cont,$id) = (
371     $files{$file}{cont},
372     $files{$file}{id}
373     );
374    
375     if (!$sth->{'update'}->execute($cont,$id)) {
376 dpavlin 9 print "update problem: ",$sth->{'update'}->errstr;
377 dpavlin 6 clear_cont;
378     return 0;
379     } else {
380 dpavlin 7 if (! $dbh->commit) {
381 dpavlin 9 print "ERROR: commit problem: ",$sth->{'update'}->errstr;
382 dpavlin 6 clear_cont;
383     return 0;
384     }
385     print "updated '$file' [",$files{$file}{id},"]\n";
386 dpavlin 24
387 dpavlin 26 $$fuse_self->{'invalidate'}->() if (ref $$fuse_self->{'invalidate'});
388 dpavlin 6 }
389     return 1;
390     }
391    
392     sub e_write {
393     my $file = filename_fixup(shift);
394 dpavlin 18 my ($buffer,$off) = @_;
395 dpavlin 6
396     return -ENOENT() unless exists($files{$file});
397    
398 dpavlin 18 my $cont = $files{$file}{cont};
399     my $len = length($cont);
400 dpavlin 6
401 dpavlin 18 print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
402 dpavlin 6
403 dpavlin 18 $files{$file}{cont} = "";
404 dpavlin 6
405 dpavlin 18 $files{$file}{cont} .= substr($cont,0,$off) if ($off > 0);
406     $files{$file}{cont} .= $buffer;
407 dpavlin 21 $files{$file}{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);
408 dpavlin 18
409     $files{$file}{size} = length($files{$file}{cont});
410    
411 dpavlin 6 if (! update_db($file)) {
412     return -ENOSYS();
413     } else {
414 dpavlin 18 return length($buffer);
415 dpavlin 6 }
416     }
417    
418     sub e_truncate {
419     my $file = filename_fixup(shift);
420     my $size = shift;
421    
422 dpavlin 18 print "truncate to $size\n";
423    
424 dpavlin 6 $files{$file}{cont} = substr($files{$file}{cont},0,$size);
425 dpavlin 18 $files{$file}{size} = $size;
426 dpavlin 6 return 0
427     };
428    
429    
430     sub e_utime {
431     my ($atime,$mtime,$file) = @_;
432     $file = filename_fixup($file);
433    
434     return -ENOENT() unless exists($files{$file});
435    
436 dpavlin 8 print "utime '$file' $atime $mtime\n";
437    
438 dpavlin 6 $files{$file}{time} = $mtime;
439     return 0;
440     }
441    
442 dpavlin 1 sub e_statfs { return 255, 1, 1, 1, 1, 2 }
443    
444 dpavlin 21 sub e_unlink {
445     my $file = filename_fixup(shift);
446    
447 dpavlin 26 if (exists( $dirs{$file} )) {
448     print "unlink '$file' will re-read template names\n";
449     print Dumper($fuse_self);
450     $$fuse_self->{'read_filenames'}->();
451     return 0;
452     } elsif (exists( $files{$file} )) {
453     print "unlink '$file' will invalidate cache\n";
454     read_content($file,$files{$file}{id});
455     return 0;
456     }
457 dpavlin 21
458 dpavlin 26 return -ENOENT();
459 dpavlin 21 }
460 dpavlin 9 1;
461     __END__
462    
463     =head1 EXPORT
464    
465     Nothing.
466    
467     =head1 SEE ALSO
468    
469     C<FUSE (Filesystem in USErspace)> website
470     L<http://sourceforge.net/projects/avf>
471    
472     =head1 AUTHOR
473    
474     Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
475    
476     =head1 COPYRIGHT AND LICENSE
477    
478     Copyright (C) 2004 by Dobrica Pavlinusic
479    
480     This library is free software; you can redistribute it and/or modify
481     it under the same terms as Perl itself, either Perl version 5.8.4 or,
482     at your option, any later version of Perl 5 you may have available.
483    
484    
485     =cut
486    

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26