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

Annotation of /fuse-couchdb/DBI.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 21 - (hide annotations)
Sat Oct 2 15:29:02 2004 UTC (19 years, 6 months ago) by dpavlin
Original Path: trunk/DBI.pm
File size: 9514 byte(s)
a lot of changes (0.03 API):
- added unlink (rm) method to invalidate in-memory cache
- added fuse_module_loaded method to check if fuse module is loaded
- fixed short read of last block
- removed Proc::Simple usage and replaced with simplier forking mechanism

This is first working version, but it's not binary-safe yet. NULL bytes
are still problem.


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

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26