/[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 24 - (hide annotations)
Fri Oct 8 20:07:12 2004 UTC (19 years, 5 months ago) by dpavlin
File size: 9933 byte(s)
call umount on DESTROY, support for optional 'invalidate' code ref which
erase templates from disk (user running fuse must have permissions on
template directory for this to work)

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

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26