/[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 18 - (hide annotations)
Sun Sep 5 16:59:41 2004 UTC (19 years, 6 months ago) by dpavlin
Original Path: trunk/DBI.pm
File size: 8813 byte(s)
broken version with DBD::SQLite (transaction problems)

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 Proc::Simple;
14     use Data::Dumper;
15 dpavlin 1
16 dpavlin 11
17 dpavlin 18 our $VERSION = '0.02';
18 dpavlin 1
19 dpavlin 9 =head1 NAME
20 dpavlin 1
21 dpavlin 9 Fuse::DBI - mount your database as filesystem and use it
22 dpavlin 1
23 dpavlin 9 =head1 SYNOPSIS
24 dpavlin 6
25 dpavlin 9 use Fuse::DBI;
26 dpavlin 11 Fuse::DBI->mount( ... );
27 dpavlin 1
28 dpavlin 9 See L<run> below for examples how to set parametars.
29 dpavlin 1
30 dpavlin 9 =head1 DESCRIPTION
31 dpavlin 1
32 dpavlin 9 This module will use L<Fuse> module, part of C<FUSE (Filesystem in USErspace)>
33     available at L<http://sourceforge.net/projects/avf> to mount
34     your database as file system.
35 dpavlin 1
36 dpavlin 9 That will give you posibility to use normal file-system tools (cat, grep, vi)
37     to manipulate data in database.
38 dpavlin 1
39 dpavlin 9 It's actually opposite of Oracle's intention to put everything into database.
40 dpavlin 1
41    
42 dpavlin 9 =head1 METHODS
43    
44     =cut
45    
46 dpavlin 11 =head2 mount
47 dpavlin 9
48     Mount your database as filesystem.
49    
50 dpavlin 11 my $mnt = Fuse::DBI->mount({
51 dpavlin 9 filenames => 'select name from filenamefilenames,
52     read => 'sql read',
53     update => 'sql update',
54     dsn => 'DBI:Pg:dbname=webgui',
55     user => 'database_user',
56     password => 'database_password'
57     });
58    
59     =cut
60    
61     my $dbh;
62     my $sth;
63     my $ctime_start;
64    
65 dpavlin 11 sub read_filenames;
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     $dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, { AutoCommit => 0 }) || die $DBI::errstr;
87    
88     print "start transaction\n";
89 dpavlin 18 $dbh->begin_work || die $dbh->errstr;
90 dpavlin 9
91     $sth->{filenames} = $dbh->prepare($arg->{'filenames'}) || die $dbh->errstr();
92    
93     $sth->{'read'} = $dbh->prepare($arg->{'read'}) || die $dbh->errstr();
94     $sth->{'update'} = $dbh->prepare($arg->{'update'}) || die $dbh->errstr();
95    
96     $ctime_start = time();
97    
98     read_filenames;
99    
100 dpavlin 11 $self->{'proc'} = Proc::Simple->new();
101     $self->{'proc'}->kill_on_destroy(1);
102    
103     $self->{'proc'}->start( sub {
104     Fuse::main(
105     mountpoint=>$arg->{'mount'},
106     getattr=>\&e_getattr,
107     getdir=>\&e_getdir,
108     open=>\&e_open,
109     statfs=>\&e_statfs,
110     read=>\&e_read,
111     write=>\&e_write,
112     utime=>\&e_utime,
113     truncate=>\&e_truncate,
114     debug=>0,
115     );
116     } );
117    
118 dpavlin 12 confess "Fuse::main failed" if (! $self->{'proc'}->poll);
119    
120 dpavlin 11 $self ? return $self : return undef;
121 dpavlin 9 };
122    
123 dpavlin 11 =head2 umount
124    
125     Unmount your database as filesystem.
126    
127     $mnt->umount;
128    
129     This will also kill background process which is translating
130     database to filesystem.
131    
132     =cut
133    
134     sub umount {
135     my $self = shift;
136    
137     confess "no process running?" unless ($self->{'proc'});
138 dpavlin 12
139     system "fusermount -u ".$self->{'mount'} || croak "umount error: $!";
140    
141     if ($self->{'proc'}->poll) {
142     $self->{'proc'}->kill;
143     return 1 if (! $self->{'proc'}->poll);
144     } else {
145     return 1;
146     }
147 dpavlin 11 }
148    
149    
150 dpavlin 9 my %files;
151 dpavlin 1 my %dirs;
152    
153 dpavlin 9 sub read_filenames {
154 dpavlin 11 my $self = shift;
155    
156 dpavlin 9 # create empty filesystem
157     (%files) = (
158     '.' => {
159     type => 0040,
160     mode => 0755,
161     },
162     # a => {
163     # cont => "File 'a'.\n",
164     # type => 0100,
165     # ctime => time()-2000
166     # },
167     );
168 dpavlin 1
169 dpavlin 9 # fetch new filename list from database
170     $sth->{'filenames'}->execute() || die $sth->{'filenames'}->errstr();
171    
172     # read them in with sesible defaults
173     while (my $row = $sth->{'filenames'}->fetchrow_hashref() ) {
174     $files{$row->{'filename'}} = {
175     size => $row->{'size'},
176     mode => $row->{'writable'} ? 0644 : 0444,
177     id => $row->{'id'} || 99,
178     };
179    
180     my $d;
181     foreach (split(m!/!, $row->{'filename'})) {
182     # first, entry is assumed to be file
183     if ($d) {
184     $files{$d} = {
185     size => $dirs{$d}++,
186     mode => 0755,
187     type => 0040
188     };
189     $files{$d.'/.'} = {
190     mode => 0755,
191     type => 0040
192     };
193     $files{$d.'/..'} = {
194     mode => 0755,
195     type => 0040
196     };
197     }
198     $d .= "/" if ($d);
199     $d .= "$_";
200 dpavlin 1 }
201     }
202 dpavlin 9
203     print "found ",scalar(keys %files)-scalar(keys %dirs)," files, ",scalar(keys %dirs), " dirs\n";
204 dpavlin 1 }
205    
206    
207     sub filename_fixup {
208     my ($file) = shift;
209     $file =~ s,^/,,;
210     $file = '.' unless length($file);
211     return $file;
212     }
213    
214     sub e_getattr {
215     my ($file) = filename_fixup(shift);
216     $file =~ s,^/,,;
217     $file = '.' unless length($file);
218     return -ENOENT() unless exists($files{$file});
219     my ($size) = $files{$file}{size} || 1;
220     my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,1,0,0,1,1024);
221     my ($atime, $ctime, $mtime);
222     $atime = $ctime = $mtime = $files{$file}{ctime} || $ctime_start;
223    
224     my ($modes) = (($files{$file}{type} || 0100)<<9) + $files{$file}{mode};
225    
226     # 2 possible types of return values:
227     #return -ENOENT(); # or any other error you care to
228     #print(join(",",($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)),"\n");
229     return ($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
230     }
231    
232     sub e_getdir {
233     my ($dirname) = shift;
234     $dirname =~ s!^/!!;
235     # return as many text filenames as you like, followed by the retval.
236     print((scalar keys %files)." files total\n");
237     my %out;
238 dpavlin 13 foreach my $f (sort keys %files) {
239 dpavlin 1 if ($dirname) {
240 dpavlin 13 if ($f =~ s/^\E$dirname\Q\///) {
241     $out{$f}++ if ($f =~ /^[^\/]+$/);
242     }
243 dpavlin 1 } else {
244     $out{$f}++ if ($f =~ /^[^\/]+$/);
245     }
246     }
247     if (! %out) {
248     $out{'no files? bug?'}++;
249     }
250 dpavlin 8 print scalar keys %out," files in dir '$dirname'\n";
251 dpavlin 13 print "## ",join(" ",keys %out),"\n";
252 dpavlin 1 return (keys %out),0;
253     }
254    
255     sub e_open {
256     # VFS sanity check; it keeps all the necessary state, not much to do here.
257 dpavlin 6 my $file = filename_fixup(shift);
258     my $flags = shift;
259    
260 dpavlin 1 return -ENOENT() unless exists($files{$file});
261     return -EISDIR() unless exists($files{$file}{id});
262 dpavlin 6
263 dpavlin 1 if (!exists($files{$file}{cont})) {
264 dpavlin 9 $sth->{'read'}->execute($files{$file}{id}) || die $sth->{'read'}->errstr;
265     $files{$file}{cont} = $sth->{'read'}->fetchrow_array;
266 dpavlin 7 print "file '$file' content read in cache\n";
267 dpavlin 1 }
268 dpavlin 3 print "open '$file' ",length($files{$file}{cont})," bytes\n";
269 dpavlin 1 return 0;
270     }
271    
272     sub e_read {
273 dpavlin 3 # return an error numeric, or binary/text string.
274     # (note: 0 means EOF, "0" will give a byte (ascii "0")
275     # to the reading program)
276 dpavlin 1 my ($file) = filename_fixup(shift);
277 dpavlin 8 my ($buf_len,$off) = @_;
278 dpavlin 3
279 dpavlin 1 return -ENOENT() unless exists($files{$file});
280 dpavlin 3
281     my $len = length($files{$file}{cont});
282    
283 dpavlin 8 print "read '$file' [$len bytes] offset $off length $buf_len\n";
284 dpavlin 3
285     return -EINVAL() if ($off > $len);
286     return 0 if ($off == $len);
287    
288 dpavlin 8 $buf_len = $buf_len-$off if ($off+$buf_len > $len);
289 dpavlin 3
290 dpavlin 8 return substr($files{$file}{cont},$off,$buf_len);
291 dpavlin 1 }
292    
293 dpavlin 6 sub clear_cont {
294 dpavlin 7 print "transaction rollback\n";
295     $dbh->rollback || die $dbh->errstr;
296 dpavlin 6 print "invalidate all cached content\n";
297     foreach my $f (keys %files) {
298     delete $files{$f}{cont};
299     }
300 dpavlin 7 print "begin new transaction\n";
301     $dbh->begin_work || die $dbh->errstr;
302 dpavlin 6 }
303    
304    
305     sub update_db {
306     my $file = shift || die;
307    
308 dpavlin 8 $files{$file}{ctime} = time();
309    
310 dpavlin 9 if (!$sth->{'update'}->execute($files{$file}{cont},$files{$file}{id})) {
311     print "update problem: ",$sth->{'update'}->errstr;
312 dpavlin 6 clear_cont;
313     return 0;
314     } else {
315 dpavlin 7 if (! $dbh->commit) {
316 dpavlin 9 print "ERROR: commit problem: ",$sth->{'update'}->errstr;
317 dpavlin 6 clear_cont;
318     return 0;
319     }
320     print "updated '$file' [",$files{$file}{id},"]\n";
321     }
322     return 1;
323     }
324    
325     sub e_write {
326     my $file = filename_fixup(shift);
327 dpavlin 18 my ($buffer,$off) = @_;
328 dpavlin 6
329     return -ENOENT() unless exists($files{$file});
330    
331 dpavlin 18 my $cont = $files{$file}{cont};
332     my $len = length($cont);
333 dpavlin 6
334 dpavlin 18 print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
335 dpavlin 6
336 dpavlin 18 $files{$file}{cont} = "";
337 dpavlin 6
338 dpavlin 18 $files{$file}{cont} .= substr($cont,0,$off) if ($off > 0);
339     $files{$file}{cont} .= $buffer;
340     $files{$file}{cont} .= substr($cont,-($off+length($buffer))) if ($off+length($buffer) > $len);
341    
342     $files{$file}{size} = length($files{$file}{cont});
343    
344 dpavlin 6 if (! update_db($file)) {
345     return -ENOSYS();
346     } else {
347 dpavlin 18 return length($buffer);
348 dpavlin 6 }
349     }
350    
351     sub e_truncate {
352     my $file = filename_fixup(shift);
353     my $size = shift;
354    
355 dpavlin 18 print "truncate to $size\n";
356    
357 dpavlin 6 $files{$file}{cont} = substr($files{$file}{cont},0,$size);
358 dpavlin 18 $files{$file}{size} = $size;
359 dpavlin 6 return 0
360     };
361    
362    
363     sub e_utime {
364     my ($atime,$mtime,$file) = @_;
365     $file = filename_fixup($file);
366    
367     return -ENOENT() unless exists($files{$file});
368    
369 dpavlin 8 print "utime '$file' $atime $mtime\n";
370    
371 dpavlin 6 $files{$file}{time} = $mtime;
372     return 0;
373     }
374    
375 dpavlin 1 sub e_statfs { return 255, 1, 1, 1, 1, 2 }
376    
377 dpavlin 9 1;
378     __END__
379    
380     =head1 EXPORT
381    
382     Nothing.
383    
384     =head1 SEE ALSO
385    
386     C<FUSE (Filesystem in USErspace)> website
387     L<http://sourceforge.net/projects/avf>
388    
389     =head1 AUTHOR
390    
391     Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
392    
393     =head1 COPYRIGHT AND LICENSE
394    
395     Copyright (C) 2004 by Dobrica Pavlinusic
396    
397     This library is free software; you can redistribute it and/or modify
398     it under the same terms as Perl itself, either Perl version 5.8.4 or,
399     at your option, any later version of Perl 5 you may have available.
400    
401    
402     =cut
403    

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26