/[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 6 by dpavlin, Wed Aug 4 16:17:09 2004 UTC trunk/DBI.pm revision 22 by dpavlin, Sat Oct 2 16:30:16 2004 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl  #!/usr/bin/perl
2    
3  use POSIX qw(ENOENT EISDIR EINVAL O_RDWR);  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                  oid as id,  use DBI;
12                  namespace||'/'||name||' ['||oid||']' as filename,  use Carp;
13                  length(template) as size,  use Data::Dumper;
                 iseditable as writable  
         from template ;  
 };  
14    
 my $sql_read = q{  
         select template  
                 from template  
                 where oid = ?;  
 };  
15    
16  my $sql_update = q{  our $VERSION = '0.03';
17          update template  
18                  set template = ?          =head1 NAME
19                  where oid = ?;  
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            foreach (qw(filenames read update)) {
83                    carp "mount needs '$_' SQL" unless ($arg->{$_});
84            }
85    
86            $ctime_start = time();
87    
88            my $pid;
89            if ($arg->{'fork'}) {
90                    $pid = fork();
91                    die "fork() failed: $!" unless defined $pid;
92                    # child will return to caller
93                    if ($pid) {
94                            return $self;
95                    }
96            }
97    
98            $dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, {AutoCommit => 0, RaiseError => 1}) || die $DBI::errstr;
99    
100            $sth->{filenames} = $dbh->prepare($arg->{'filenames'}) || die $dbh->errstr();
101    
102            $sth->{'read'} = $dbh->prepare($arg->{'read'}) || die $dbh->errstr();
103            $sth->{'update'} = $dbh->prepare($arg->{'update'}) || die $dbh->errstr();
104    
105            $self->read_filenames;
106    
107            Fuse::main(
108                    mountpoint=>$arg->{'mount'},
109                    getattr=>\&e_getattr,
110                    getdir=>\&e_getdir,
111                    open=>\&e_open,
112                    statfs=>\&e_statfs,
113                    read=>\&e_read,
114                    write=>\&e_write,
115                    utime=>\&e_utime,
116                    truncate=>\&e_truncate,
117                    unlink=>\&e_unlink,
118                    debug=>0,
119            );
120    
121            exit(0) if ($arg->{'fork'});
122    
123            return 1;
124    
125  };  };
126    
127    =head2 umount
128    
129  my $connect = "DBI:Pg:dbname=webgui";  Unmount your database as filesystem.
130    
131  my $dbh = DBI->connect($connect,"","") || die $DBI::errstr;    $mnt->umount;
132    
133  print STDERR "$sql_filenames\n";  This will also kill background process which is translating
134    database to filesystem.
135    
136  my $sth_filenames = $dbh->prepare($sql_filenames) || die $dbh->errstr();  =cut
 $sth_filenames->execute() || die $sth_filenames->errstr();  
137    
138  my $sth_read = $dbh->prepare($sql_read) || die $dbh->errstr();  sub umount {
139  my $sth_update = $dbh->prepare($sql_update) || die $dbh->errstr();          my $self = shift;
140    
141  print "#",join(",",@{ $sth_filenames->{NAME} }),"\n";          system "fusermount -u ".$self->{'mount'} || croak "umount error: $!";
142    
143  my $ctime_start = time();          return 1;
144    }
145    
146  my (%files) = (  =head2 fuse_module_loaded
         '.' => {  
                 type => 0040,  
                 mode => 0755,  
         },  
 #       a => {  
 #               cont => "File 'a'.\n",  
 #               type => 0100,  
 #               ctime => time()-2000  
 #       },  
 );  
147    
148    Checks if C<fuse> module is loaded in kernel.
149    
150      die "no fuse module loaded in kernel"
151            unless (Fuse::DBI::fuse_module_loaded);
152    
153    This function in called by L<mount>, but might be useful alone also.
154    
155    =cut
156    
157    sub fuse_module_loaded {
158            my $lsmod = `lsmod`;
159            die "can't start lsmod: $!" unless ($lsmod);
160            if ($lsmod =~ m/fuse/s) {
161                    return 1;
162            } else {
163                    return 0;
164            }
165    }
166    
167    my %files;
168  my %dirs;  my %dirs;
169    
170  while (my $row = $sth_filenames->fetchrow_hashref() ) {  sub read_filenames {
171          $files{$row->{'filename'}} = {          my $self = shift;
172                  size => $row->{'size'},  
173                  mode => $row->{'writable'} ? 0644 : 0444,          # create empty filesystem
174                  id => $row->{'id'} || 99,          (%files) = (
175          };                  '.' => {
176                            type => 0040,
177          my $d;                          mode => 0755,
178          foreach (split(m!/!, $row->{'filename'})) {                  },
179                  # first, entry is assumed to be file          #       a => {
180                  if ($d) {          #               cont => "File 'a'.\n",
181                          $files{$d} = {          #               type => 0100,
182                                          size => $dirs{$d}++,          #               ctime => time()-2000
183                                          mode => 0755,          #       },
184                                          type => 0040          );
185                          };  
186                          $files{$d.'/.'} = {          # fetch new filename list from database
187                                          mode => 0755,          $sth->{'filenames'}->execute() || die $sth->{'filenames'}->errstr();
188                                          type => 0040  
189                          };          # read them in with sesible defaults
190                          $files{$d.'/..'} = {          while (my $row = $sth->{'filenames'}->fetchrow_hashref() ) {
191                                          mode => 0755,                  $files{$row->{'filename'}} = {
192                                          type => 0040                          size => $row->{'size'},
193                          };                          mode => $row->{'writable'} ? 0644 : 0444,
194                            id => $row->{'id'} || 99,
195                    };
196    
197                    my $d;
198                    foreach (split(m!/!, $row->{'filename'})) {
199                            # first, entry is assumed to be file
200                            if ($d) {
201                                    $files{$d} = {
202                                                    size => $dirs{$d}++,
203                                                    mode => 0755,
204                                                    type => 0040
205                                    };
206                                    $files{$d.'/.'} = {
207                                                    mode => 0755,
208                                                    type => 0040
209                                    };
210                                    $files{$d.'/..'} = {
211                                                    mode => 0755,
212                                                    type => 0040
213                                    };
214                            }
215                            $d .= "/" if ($d);
216                            $d .= "$_";
217                  }                  }
                 $d .= "/" if ($d);  
                 $d .= "$_";  
218          }          }
219    
220            print "found ",scalar(keys %files)-scalar(keys %dirs)," files, ",scalar(keys %dirs), " dirs\n";
221  }  }
222    
 print scalar (keys %dirs), " dirs:",join(" ",keys %dirs),"\n";  
223    
224  sub filename_fixup {  sub filename_fixup {
225          my ($file) = shift;          my ($file) = shift;
# Line 121  sub e_getdir { Line 252  sub e_getdir {
252          # return as many text filenames as you like, followed by the retval.          # return as many text filenames as you like, followed by the retval.
253          print((scalar keys %files)." files total\n");          print((scalar keys %files)." files total\n");
254          my %out;          my %out;
255          foreach (keys %files) {          foreach my $f (sort keys %files) {
                 my $f = $_;  
                 $f =~ s/^\E$dirname\Q//;  
                 $f =~ s/^\///;  
256                  if ($dirname) {                  if ($dirname) {
257                          $out{$f}++ if (/^\E$dirname\Q/ && $f =~ /^[^\/]+$/);                          if ($f =~ s/^\E$dirname\Q\///) {
258                                    $out{$f}++ if ($f =~ /^[^\/]+$/);
259                            }
260                  } else {                  } else {
261                          $out{$f}++ if ($f =~ /^[^\/]+$/);                          $out{$f}++ if ($f =~ /^[^\/]+$/);
262                  }                  }
                 print "f: $_ -> $f\n";  
263          }          }
264          if (! %out) {          if (! %out) {
265                  $out{'no files? bug?'}++;                  $out{'no files? bug?'}++;
266          }          }
267          print scalar keys %out," files found for '$dirname': ",keys %out,"\n";          print scalar keys %out," files in dir '$dirname'\n";
268            print "## ",join(" ",keys %out),"\n";
269          return (keys %out),0;          return (keys %out),0;
270  }  }
271    
272  my $in_transaction = 0;  sub read_content {
273            my ($file,$id) = @_;
274    
275            die "read_content needs file and id" unless ($file && $id);
276    
277            $sth->{'read'}->execute($id) || die $sth->{'read'}->errstr;
278            $files{$file}{cont} = $sth->{'read'}->fetchrow_array;
279            print "file '$file' content [",length($files{$file}{cont})," bytes] read in cache\n";
280    }
281    
282    
283  sub e_open {  sub e_open {
284          # 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.
# Line 149  sub e_open { Line 288  sub e_open {
288          return -ENOENT() unless exists($files{$file});          return -ENOENT() unless exists($files{$file});
289          return -EISDIR() unless exists($files{$file}{id});          return -EISDIR() unless exists($files{$file}{id});
290    
291          if (! $in_transaction) {          read_content($file,$files{$file}{id}) unless exists($files{$file}{cont});
                 # begin transaction  
                 if (! $dbh->begin_work) {  
                         print "transaction begin: ",$dbh->errstr;  
                         return -ENOENT();  
                 }  
         }  
         $in_transaction++;  
         print "files opened: $in_transaction\n";  
292    
         if (!exists($files{$file}{cont})) {  
                 $sth_read->execute($files{$file}{id}) || die $sth_read->errstr;  
                 $files{$file}{cont} = $sth_read->fetchrow_array;  
         }  
293          print "open '$file' ",length($files{$file}{cont})," bytes\n";          print "open '$file' ",length($files{$file}{cont})," bytes\n";
294          return 0;          return 0;
295  }  }
# Line 172  sub e_read { Line 299  sub e_read {
299          # (note: 0 means EOF, "0" will give a byte (ascii "0")          # (note: 0 means EOF, "0" will give a byte (ascii "0")
300          # to the reading program)          # to the reading program)
301          my ($file) = filename_fixup(shift);          my ($file) = filename_fixup(shift);
302          my ($buf,$off) = @_;          my ($buf_len,$off) = @_;
303    
304          return -ENOENT() unless exists($files{$file});          return -ENOENT() unless exists($files{$file});
305    
306          my $len = length($files{$file}{cont});          my $len = length($files{$file}{cont});
307    
308          print "read '$file' [$len bytes] offset $off length $buf\n";          print "read '$file' [$len bytes] offset $off length $buf_len\n";
309    
310          return -EINVAL() if ($off > $len);          return -EINVAL() if ($off > $len);
311          return 0 if ($off == $len);          return 0 if ($off == $len);
312    
313          $buf = $len-$off if ($off+$buf > $len);          $buf_len = $len-$off if ($len - $off < $buf_len);
314    
315          return substr($files{$file}{cont},$off,$buf);          return substr($files{$file}{cont},$off,$buf_len);
316  }  }
317    
318  sub clear_cont {  sub clear_cont {
319            print "transaction rollback\n";
320            $dbh->rollback || die $dbh->errstr;
321          print "invalidate all cached content\n";          print "invalidate all cached content\n";
322          foreach my $f (keys %files) {          foreach my $f (keys %files) {
323                  delete $files{$f}{cont};                  delete $files{$f}{cont};
324          }          }
325            print "begin new transaction\n";
326            #$dbh->begin_work || die $dbh->errstr;
327  }  }
328    
329    
330  sub update_db {  sub update_db {
331          my $file = shift || die;          my $file = shift || die;
332    
333          if (!$sth_update->execute($files{$file}{cont},$files{$file}{id})) {          $files{$file}{ctime} = time();
334                  print "update problem: ",$sth_update->errstr;  
335                  $dbh->rollback;          my ($cont,$id) = (
336                    $files{$file}{cont},
337                    $files{$file}{id}
338            );
339    
340            if (!$sth->{'update'}->execute($cont,$id)) {
341                    print "update problem: ",$sth->{'update'}->errstr;
342                  clear_cont;                  clear_cont;
                 $dbh->begin_work;  
343                  return 0;                  return 0;
344          } else {          } else {
345                  if ($dbh->commit) {                  if (! $dbh->commit) {
346                          print "commit problem: ",$sth_update->errstr;                          print "ERROR: commit problem: ",$sth->{'update'}->errstr;
                         $dbh->rollback;  
347                          clear_cont;                          clear_cont;
                         $dbh->begin_work;  
348                          return 0;                          return 0;
349                  }                  }
350                  print "updated '$file' [",$files{$file}{id},"]\n";                  print "updated '$file' [",$files{$file}{id},"]\n";
# Line 220  sub update_db { Line 354  sub update_db {
354    
355  sub e_write {  sub e_write {
356          my $file = filename_fixup(shift);          my $file = filename_fixup(shift);
357          my ($buf,$off) = @_;          my ($buffer,$off) = @_;
358    
359          return -ENOENT() unless exists($files{$file});          return -ENOENT() unless exists($files{$file});
360    
361          my $len = length($files{$file}{cont});          my $cont = $files{$file}{cont};
362            my $len = length($cont);
363    
364            print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
365    
366            $files{$file}{cont} = "";
367    
368          print "write '$file' [$len bytes] offset $off length $buf\n";          $files{$file}{cont} .= substr($cont,0,$off) if ($off > 0);
369            $files{$file}{cont} .= $buffer;
370            $files{$file}{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);
371    
372          $files{$file}{cont} =          $files{$file}{size} = length($files{$file}{cont});
                 substr($files{$file}{cont},0,$off) .  
                 $buf .  
                 substr($files{$file}{cont},$off+length($buf));  
373    
374          if (! update_db($file)) {          if (! update_db($file)) {
375                  return -ENOSYS();                  return -ENOSYS();
376          } else {          } else {
377                  return length($buf);                  return length($buffer);
378          }          }
379  }  }
380    
# Line 244  sub e_truncate { Line 382  sub e_truncate {
382          my $file = filename_fixup(shift);          my $file = filename_fixup(shift);
383          my $size = shift;          my $size = shift;
384    
385            print "truncate to $size\n";
386    
387          $files{$file}{cont} = substr($files{$file}{cont},0,$size);          $files{$file}{cont} = substr($files{$file}{cont},0,$size);
388            $files{$file}{size} = $size;
389          return 0          return 0
390  };  };
391    
# Line 255  sub e_utime { Line 396  sub e_utime {
396    
397          return -ENOENT() unless exists($files{$file});          return -ENOENT() unless exists($files{$file});
398    
399            print "utime '$file' $atime $mtime\n";
400    
401          $files{$file}{time} = $mtime;          $files{$file}{time} = $mtime;
402          return 0;          return 0;
403  }  }
404    
405  sub e_statfs { return 255, 1, 1, 1, 1, 2 }  sub e_statfs { return 255, 1, 1, 1, 1, 2 }
406    
407  # If you run the script directly, it will run fusermount, which will in turn  sub e_unlink {
408  # re-run this script.  Hence the funky semantics.          my $file = filename_fixup(shift);
409  my ($mountpoint) = "";  
410  $mountpoint = shift(@ARGV) if @ARGV;          return -ENOENT() unless exists($files{$file});
411  Fuse::main(  
412          mountpoint=>$mountpoint,          print "unlink '$file' will invalidate cache\n";
413          getattr=>\&e_getattr,  
414          getdir=>\&e_getdir,          read_content($file,$files{$file}{id});
415          open=>\&e_open,  
416          statfs=>\&e_statfs,          return 0;
417          read=>\&e_read,  }
418          write=>\&e_write,  1;
419          utime=>\&e_utime,  __END__
420          truncate=>\&e_truncate,  
421          debug=>1,  =head1 EXPORT
422  );  
423    Nothing.
424    
425    =head1 SEE ALSO
426    
427    C<FUSE (Filesystem in USErspace)> website
428    L<http://sourceforge.net/projects/avf>
429    
430    =head1 AUTHOR
431    
432    Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
433    
434    =head1 COPYRIGHT AND LICENSE
435    
436    Copyright (C) 2004 by Dobrica Pavlinusic
437    
438    This library is free software; you can redistribute it and/or modify
439    it under the same terms as Perl itself, either Perl version 5.8.4 or,
440    at your option, any later version of Perl 5 you may have available.
441    
442    
443    =cut
444    
Legend:
Removed from v.6  
changed lines
  Added in v.22
  ViewVC Help
Powered by ViewVC 1.1.26