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

Contents of /trunk/DBI.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 18 - (show annotations)
Sun Sep 5 16:59:41 2004 UTC (19 years, 6 months ago) by dpavlin
File size: 8813 byte(s)
broken version with DBD::SQLite (transaction problems)

1 #!/usr/bin/perl
2
3 package Fuse::DBI;
4
5 use 5.008;
6 use strict;
7 use warnings;
8
9 use POSIX qw(ENOENT EISDIR EINVAL ENOSYS O_RDWR);
10 use Fuse;
11 use DBI;
12 use Carp;
13 use Proc::Simple;
14 use Data::Dumper;
15
16
17 our $VERSION = '0.02';
18
19 =head1 NAME
20
21 Fuse::DBI - mount your database as filesystem and use it
22
23 =head1 SYNOPSIS
24
25 use Fuse::DBI;
26 Fuse::DBI->mount( ... );
27
28 See L<run> below for examples how to set parametars.
29
30 =head1 DESCRIPTION
31
32 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
36 That will give you posibility to use normal file-system tools (cat, grep, vi)
37 to manipulate data in database.
38
39 It's actually opposite of Oracle's intention to put everything into database.
40
41
42 =head1 METHODS
43
44 =cut
45
46 =head2 mount
47
48 Mount your database as filesystem.
49
50 my $mnt = Fuse::DBI->mount({
51 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 sub read_filenames;
66
67 sub mount {
68 my $class = shift;
69 my $self = {};
70 bless($self, $class);
71
72 my $arg = shift;
73
74 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 # save (some) arguments in self
80 $self->{$_} = $arg->{$_} foreach (qw(mount));
81
82 foreach (qw(filenames read update)) {
83 carp "mount needs '$_' SQL" unless ($arg->{$_});
84 }
85
86 $dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, { AutoCommit => 0 }) || die $DBI::errstr;
87
88 print "start transaction\n";
89 $dbh->begin_work || die $dbh->errstr;
90
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 $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 confess "Fuse::main failed" if (! $self->{'proc'}->poll);
119
120 $self ? return $self : return undef;
121 };
122
123 =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
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 }
148
149
150 my %files;
151 my %dirs;
152
153 sub read_filenames {
154 my $self = shift;
155
156 # 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
169 # 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 }
201 }
202
203 print "found ",scalar(keys %files)-scalar(keys %dirs)," files, ",scalar(keys %dirs), " dirs\n";
204 }
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 foreach my $f (sort keys %files) {
239 if ($dirname) {
240 if ($f =~ s/^\E$dirname\Q\///) {
241 $out{$f}++ if ($f =~ /^[^\/]+$/);
242 }
243 } else {
244 $out{$f}++ if ($f =~ /^[^\/]+$/);
245 }
246 }
247 if (! %out) {
248 $out{'no files? bug?'}++;
249 }
250 print scalar keys %out," files in dir '$dirname'\n";
251 print "## ",join(" ",keys %out),"\n";
252 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 my $file = filename_fixup(shift);
258 my $flags = shift;
259
260 return -ENOENT() unless exists($files{$file});
261 return -EISDIR() unless exists($files{$file}{id});
262
263 if (!exists($files{$file}{cont})) {
264 $sth->{'read'}->execute($files{$file}{id}) || die $sth->{'read'}->errstr;
265 $files{$file}{cont} = $sth->{'read'}->fetchrow_array;
266 print "file '$file' content read in cache\n";
267 }
268 print "open '$file' ",length($files{$file}{cont})," bytes\n";
269 return 0;
270 }
271
272 sub e_read {
273 # 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 my ($file) = filename_fixup(shift);
277 my ($buf_len,$off) = @_;
278
279 return -ENOENT() unless exists($files{$file});
280
281 my $len = length($files{$file}{cont});
282
283 print "read '$file' [$len bytes] offset $off length $buf_len\n";
284
285 return -EINVAL() if ($off > $len);
286 return 0 if ($off == $len);
287
288 $buf_len = $buf_len-$off if ($off+$buf_len > $len);
289
290 return substr($files{$file}{cont},$off,$buf_len);
291 }
292
293 sub clear_cont {
294 print "transaction rollback\n";
295 $dbh->rollback || die $dbh->errstr;
296 print "invalidate all cached content\n";
297 foreach my $f (keys %files) {
298 delete $files{$f}{cont};
299 }
300 print "begin new transaction\n";
301 $dbh->begin_work || die $dbh->errstr;
302 }
303
304
305 sub update_db {
306 my $file = shift || die;
307
308 $files{$file}{ctime} = time();
309
310 if (!$sth->{'update'}->execute($files{$file}{cont},$files{$file}{id})) {
311 print "update problem: ",$sth->{'update'}->errstr;
312 clear_cont;
313 return 0;
314 } else {
315 if (! $dbh->commit) {
316 print "ERROR: commit problem: ",$sth->{'update'}->errstr;
317 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 my ($buffer,$off) = @_;
328
329 return -ENOENT() unless exists($files{$file});
330
331 my $cont = $files{$file}{cont};
332 my $len = length($cont);
333
334 print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
335
336 $files{$file}{cont} = "";
337
338 $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 if (! update_db($file)) {
345 return -ENOSYS();
346 } else {
347 return length($buffer);
348 }
349 }
350
351 sub e_truncate {
352 my $file = filename_fixup(shift);
353 my $size = shift;
354
355 print "truncate to $size\n";
356
357 $files{$file}{cont} = substr($files{$file}{cont},0,$size);
358 $files{$file}{size} = $size;
359 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 print "utime '$file' $atime $mtime\n";
370
371 $files{$file}{time} = $mtime;
372 return 0;
373 }
374
375 sub e_statfs { return 255, 1, 1, 1, 1, 2 }
376
377 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