/[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 11 - (show annotations)
Sun Aug 29 18:51:29 2004 UTC (19 years, 7 months ago) by dpavlin
File size: 8248 byte(s)
first try at making this module (late commit)

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

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26