/[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 9 - (hide annotations)
Sat Aug 7 19:06:03 2004 UTC (19 years, 7 months ago) by dpavlin
Original Path: trunk/DBI.pm
File size: 7626 byte(s)
move code to Fuse::DBI module (probably broken now)

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

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26