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

Diff of /fuse-couchdb/DBI.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/fuse_dbi.pl revision 2 by dpavlin, Wed Aug 4 09:03:05 2004 UTC trunk/DBI.pm revision 21 by dpavlin, Sat Oct 2 15:29:02 2004 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl  #!/usr/bin/perl
2    
3  use POSIX qw(ENOENT EISDIR EINVAL);  package Fuse::DBI;
 use Fuse;  
4    
5  use DBI;  use 5.008;
6  use strict;  use strict;
7    use warnings;
8    
9  my $sql_filenames = q{  use POSIX qw(ENOENT EISDIR EINVAL ENOSYS O_RDWR);
10          select  use Fuse;
11                  templateid as id,  use DBI;
12                  namespace||'/'||name||' ['||templateid||']' as filename,  use Carp;
13                  length(template) as size,  use Data::Dumper;
14                  iseditable as writable  
15          from template ;  
16  };  our $VERSION = '0.03';
17    
18    =head1 NAME
19    
20    Fuse::DBI - mount your database as filesystem and use it
21    
22    =head1 SYNOPSIS
23    
24      use Fuse::DBI;
25      Fuse::DBI->mount( ... );
26    
27    See L<run> below for examples how to set parametars.
28    
29    =head1 DESCRIPTION
30    
31    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    
35    That will give you posibility to use normal file-system tools (cat, grep, vi)
36    to manipulate data in database.
37    
38    It's actually opposite of Oracle's intention to put everything into database.
39    
40    
41    =head1 METHODS
42    
43    =cut
44    
45    =head2 mount
46    
47    Mount your database as filesystem.
48    
49      my $mnt = Fuse::DBI->mount({
50            filenames => 'select name from files_table as filenames',
51            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    sub read_filenames;
65    sub fuse_module_loaded;
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  my $sql_content = q{          foreach (qw(filenames read update)) {
83          select template                  carp "mount needs '$_' SQL" unless ($arg->{$_});
84          from template          }
85          where templateid = ?;  
86            $ctime_start = time();
87    
88            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    
97            $dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, {AutoCommit => 0, RaiseError => 1}) || die $DBI::errstr;
98    
99            $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            $self->read_filenames;
105    
106            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    
120            if (! $mount) {
121                    warn "mount on ",$arg->{'mount'}," failed!\n";
122                    return undef;
123            }
124  };  };
125    
126    =head2 umount
127    
128    Unmount your database as filesystem.
129    
130  my $connect = "DBI:Pg:dbname=webgui";    $mnt->umount;
131    
132  my $dbh = DBI->connect($connect,"","") || die $DBI::errstr;  This will also kill background process which is translating
133    database to filesystem.
134    
135  print STDERR "$sql_filenames\n";  =cut
136    
137  my $sth_filenames = $dbh->prepare($sql_filenames) || die $dbh->errstr();  sub umount {
138  $sth_filenames->execute() || die $sth_filenames->errstr();          my $self = shift;
139    
140            system "fusermount -u ".$self->{'mount'} || croak "umount error: $!";
141    
142            return 1;
143    }
144    
145  my $sth_content = $dbh->prepare($sql_content) || die $dbh->errstr();  =head2 fuse_module_loaded
146    
147  print "#",join(",",@{ $sth_filenames->{NAME} }),"\n";  Checks if C<fuse> module is loaded in kernel.
148    
149  my $ctime_start = time();    die "no fuse module loaded in kernel"
150            unless (Fuse::DBI::fuse_module_loaded);
151    
152  my (%files) = (  This function in called by L<mount>, but might be useful alone also.
         '.' => {  
                 type => 0040,  
                 mode => 0755,  
         },  
 #       a => {  
 #               cont => "File 'a'.\n",  
 #               type => 0100,  
 #               ctime => time()-2000  
 #       },  
 );  
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            } else {
162                    return 0;
163            }
164    }
165    
166    my %files;
167  my %dirs;  my %dirs;
168    
169  while (my $row = $sth_filenames->fetchrow_hashref() ) {  sub read_filenames {
170          $files{$row->{'filename'}} = {          my $self = shift;
171                  size => $row->{'size'},  
172                  mode => $row->{'writable'} ? 0644 : 0444,          # create empty filesystem
173                  id => $row->{'id'} || 99,          (%files) = (
174          };                  '.' => {
175                            type => 0040,
176          my $d;                          mode => 0755,
177          foreach (split(m!/!, $row->{'filename'})) {                  },
178                  # first, entry is assumed to be file          #       a => {
179                  if ($d) {          #               cont => "File 'a'.\n",
180                          $files{$d} = {          #               type => 0100,
181                                          size => $dirs{$d}++,          #               ctime => time()-2000
182                                          mode => 0755,          #       },
183                                          type => 0040          );
184                          };  
185                          $files{$d.'/.'} = {          # fetch new filename list from database
186                                          mode => 0755,          $sth->{'filenames'}->execute() || die $sth->{'filenames'}->errstr();
187                                          type => 0040  
188                          };          # read them in with sesible defaults
189                          $files{$d.'/..'} = {          while (my $row = $sth->{'filenames'}->fetchrow_hashref() ) {
190                                          mode => 0755,                  $files{$row->{'filename'}} = {
191                                          type => 0040                          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                  }                  }
                 $d .= "/" if ($d);  
                 $d .= "$_";  
217          }          }
218    
219            print "found ",scalar(keys %files)-scalar(keys %dirs)," files, ",scalar(keys %dirs), " dirs\n";
220  }  }
221    
 print scalar (keys %dirs), " dirs:",join(" ",keys %dirs),"\n";  
222    
223  sub filename_fixup {  sub filename_fixup {
224          my ($file) = shift;          my ($file) = shift;
# Line 114  sub e_getdir { Line 251  sub e_getdir {
251          # return as many text filenames as you like, followed by the retval.          # return as many text filenames as you like, followed by the retval.
252          print((scalar keys %files)." files total\n");          print((scalar keys %files)." files total\n");
253          my %out;          my %out;
254          foreach (keys %files) {          foreach my $f (sort keys %files) {
                 my $f = $_;  
                 $f =~ s/^\E$dirname\Q//;  
                 $f =~ s/^\///;  
255                  if ($dirname) {                  if ($dirname) {
256                          $out{$f}++ if (/^\E$dirname\Q/ && $f =~ /^[^\/]+$/);                          if ($f =~ s/^\E$dirname\Q\///) {
257                                    $out{$f}++ if ($f =~ /^[^\/]+$/);
258                            }
259                  } else {                  } else {
260                          $out{$f}++ if ($f =~ /^[^\/]+$/);                          $out{$f}++ if ($f =~ /^[^\/]+$/);
261                  }                  }
                 print "f: $_ -> $f\n";  
262          }          }
263          if (! %out) {          if (! %out) {
264                  $out{'no files? bug?'}++;                  $out{'no files? bug?'}++;
265          }          }
266          print scalar keys %out," files found for '$dirname': ",keys %out,"\n";          print scalar keys %out," files in dir '$dirname'\n";
267            print "## ",join(" ",keys %out),"\n";
268          return (keys %out),0;          return (keys %out),0;
269  }  }
270    
271    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  sub e_open {  sub e_open {
283          # VFS sanity check; it keeps all the necessary state, not much to do here.          # VFS sanity check; it keeps all the necessary state, not much to do here.
284          my ($file) = filename_fixup(shift);          my $file = filename_fixup(shift);
285          print("open called\n");          my $flags = shift;
286    
287          return -ENOENT() unless exists($files{$file});          return -ENOENT() unless exists($files{$file});
288          return -EISDIR() unless exists($files{$file}{id});          return -EISDIR() unless exists($files{$file}{id});
289          if (!exists($files{$file}{cont})) {  
290                  $sth_content->execute($files{$file}{id});          read_content($file,$files{$file}{id}) unless exists($files{$file}{cont});
291                  ($files{$file}{cont}) = $sth_content->fetchrow_array;  
292          }          print "open '$file' ",length($files{$file}{cont})," bytes\n";
         print("open ok\n");  
293          return 0;          return 0;
294  }  }
295    
296  sub e_read {  sub e_read {
297          # return an error numeric, or binary/text string.  (note: 0 means EOF, "0" will          # return an error numeric, or binary/text string.
298          # give a byte (ascii "0") to the reading program)          # (note: 0 means EOF, "0" will give a byte (ascii "0")
299            # to the reading program)
300          my ($file) = filename_fixup(shift);          my ($file) = filename_fixup(shift);
301          my ($buf,$off) = @_;          my ($buf_len,$off) = @_;
302    
303            return -ENOENT() unless exists($files{$file});
304    
305            my $len = length($files{$file}{cont});
306    
307            print "read '$file' [$len bytes] offset $off length $buf_len\n";
308    
309            return -EINVAL() if ($off > $len);
310            return 0 if ($off == $len);
311    
312            $buf_len = $len-$off if ($len - $off < $buf_len);
313    
314            return substr($files{$file}{cont},$off,$buf_len);
315    }
316    
317    sub clear_cont {
318            print "transaction rollback\n";
319            $dbh->rollback || die $dbh->errstr;
320            print "invalidate all cached content\n";
321            foreach my $f (keys %files) {
322                    delete $files{$f}{cont};
323            }
324            print "begin new transaction\n";
325            #$dbh->begin_work || die $dbh->errstr;
326    }
327    
328    
329    sub update_db {
330            my $file = shift || die;
331    
332            $files{$file}{ctime} = time();
333    
334            my ($cont,$id) = (
335                    $files{$file}{cont},
336                    $files{$file}{id}
337            );
338    
339            if (!$sth->{'update'}->execute($cont,$id)) {
340                    print "update problem: ",$sth->{'update'}->errstr;
341                    clear_cont;
342                    return 0;
343            } else {
344                    if (! $dbh->commit) {
345                            print "ERROR: commit problem: ",$sth->{'update'}->errstr;
346                            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            my ($buffer,$off) = @_;
357    
358            return -ENOENT() unless exists($files{$file});
359    
360            my $cont = $files{$file}{cont};
361            my $len = length($cont);
362    
363            print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
364    
365            $files{$file}{cont} = "";
366    
367            $files{$file}{cont} .= substr($cont,0,$off) if ($off > 0);
368            $files{$file}{cont} .= $buffer;
369            $files{$file}{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);
370    
371            $files{$file}{size} = length($files{$file}{cont});
372    
373            if (! update_db($file)) {
374                    return -ENOSYS();
375            } else {
376                    return length($buffer);
377            }
378    }
379    
380    sub e_truncate {
381            my $file = filename_fixup(shift);
382            my $size = shift;
383    
384            print "truncate to $size\n";
385    
386            $files{$file}{cont} = substr($files{$file}{cont},0,$size);
387            $files{$file}{size} = $size;
388            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});          return -ENOENT() unless exists($files{$file});
397          return -EINVAL() if $off > length($files{$file}{cont});  
398          return 0 if $off == length($files{$file}{cont});          print "utime '$file' $atime $mtime\n";
399          return substr($files{$file}{cont},$off,$buf);  
400            $files{$file}{time} = $mtime;
401            return 0;
402  }  }
403    
404  sub e_statfs { return 255, 1, 1, 1, 1, 2 }  sub e_statfs { return 255, 1, 1, 1, 1, 2 }
405    
406  # If you run the script directly, it will run fusermount, which will in turn  sub e_unlink {
407  # re-run this script.  Hence the funky semantics.          my $file = filename_fixup(shift);
408  my ($mountpoint) = "";  
409  $mountpoint = shift(@ARGV) if @ARGV;          return -ENOENT() unless exists($files{$file});
410  Fuse::main(  
411          mountpoint=>$mountpoint,          print "unlink '$file' will invalidate cache\n";
412          getattr=>\&e_getattr,  
413          getdir=>\&e_getdir,          read_content($file,$files{$file}{id});
414          open=>\&e_open,  
415          statfs=>\&e_statfs,          return 0;
416          read=>\&e_read,  }
417          debug=>1,  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    
Legend:
Removed from v.2  
changed lines
  Added in v.21
  ViewVC Help
Powered by ViewVC 1.1.26