/[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 7 by dpavlin, Sat Aug 7 14:48:23 2004 UTC trunk/DBI.pm revision 13 by dpavlin, Sun Aug 29 20:12:37 2004 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl  #!/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);  use POSIX qw(ENOENT EISDIR EINVAL ENOSYS O_RDWR);
10  use Fuse;  use Fuse;
   
11  use DBI;  use DBI;
12  use strict;  use Carp;
13    use Proc::Simple;
14    use Data::Dumper;
15    
 my $sql_filenames = q{  
         select  
                 oid as id,  
                 namespace||'/'||name||' ['||oid||']' as filename,  
                 length(template) as size,  
                 iseditable as writable  
         from template ;  
 };  
16    
17  my $sql_read = q{  our $VERSION = '0.01';
18          select template  
19                  from template  =head1 NAME
20                  where oid = ?;  
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  my $sql_update = q{          print "start transaction\n";
89          update template          #$dbh->begin_work || die $dbh->errstr;
90                  set template = ?          
91                  where oid = ?;          $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  my $connect = "DBI:Pg:dbname=webgui";  Unmount your database as filesystem.
126    
127  my $dbh = DBI->connect($connect,"","", { AutoCommit => 0 }) || die $DBI::errstr;    $mnt->umount;
128    
129  print "start transaction\n";  This will also kill background process which is translating
130  #$dbh->begin_work || die $dbh->errstr;  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    
 my $sth_filenames = $dbh->prepare($sql_filenames) || die $dbh->errstr();  
 $sth_filenames->execute() || die $sth_filenames->errstr();  
   
 my $sth_read = $dbh->prepare($sql_read) || die $dbh->errstr();  
 my $sth_update = $dbh->prepare($sql_update) || die $dbh->errstr();  
   
 my $ctime_start = time();  
   
 my (%files) = (  
         '.' => {  
                 type => 0040,  
                 mode => 0755,  
         },  
 #       a => {  
 #               cont => "File 'a'.\n",  
 #               type => 0100,  
 #               ctime => time()-2000  
 #       },  
 );  
149    
150    my %files;
151  my %dirs;  my %dirs;
152    
153  while (my $row = $sth_filenames->fetchrow_hashref() ) {  sub read_filenames {
154          $files{$row->{'filename'}} = {          my $self = shift;
155                  size => $row->{'size'},  
156                  mode => $row->{'writable'} ? 0644 : 0444,          # create empty filesystem
157                  id => $row->{'id'} || 99,          (%files) = (
158          };                  '.' => {
159                            type => 0040,
160          my $d;                          mode => 0755,
161          foreach (split(m!/!, $row->{'filename'})) {                  },
162                  # first, entry is assumed to be file          #       a => {
163                  if ($d) {          #               cont => "File 'a'.\n",
164                          $files{$d} = {          #               type => 0100,
165                                          size => $dirs{$d}++,          #               ctime => time()-2000
166                                          mode => 0755,          #       },
167                                          type => 0040          );
168                          };  
169                          $files{$d.'/.'} = {          # fetch new filename list from database
170                                          mode => 0755,          $sth->{'filenames'}->execute() || die $sth->{'filenames'}->errstr();
171                                          type => 0040  
172                          };          # read them in with sesible defaults
173                          $files{$d.'/..'} = {          while (my $row = $sth->{'filenames'}->fetchrow_hashref() ) {
174                                          mode => 0755,                  $files{$row->{'filename'}} = {
175                                          type => 0040                          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                  }                  }
                 $d .= "/" if ($d);  
                 $d .= "$_";  
201          }          }
202    
203            print "found ",scalar(keys %files)-scalar(keys %dirs)," files, ",scalar(keys %dirs), " dirs\n";
204  }  }
205    
 print "found ",scalar(keys %files)-scalar(keys %dirs)," files, ",scalar(keys %dirs), " dirs\n";  
206    
207  sub filename_fixup {  sub filename_fixup {
208          my ($file) = shift;          my ($file) = shift;
# Line 120  sub e_getdir { Line 235  sub e_getdir {
235          # return as many text filenames as you like, followed by the retval.          # return as many text filenames as you like, followed by the retval.
236          print((scalar keys %files)." files total\n");          print((scalar keys %files)." files total\n");
237          my %out;          my %out;
238          foreach (keys %files) {          foreach my $f (sort keys %files) {
                 my $f = $_;  
                 $f =~ s/^\E$dirname\Q//;  
                 $f =~ s/^\///;  
239                  if ($dirname) {                  if ($dirname) {
240                          $out{$f}++ if (/^\E$dirname\Q/ && $f =~ /^[^\/]+$/);                          if ($f =~ s/^\E$dirname\Q\///) {
241                                    $out{$f}++ if ($f =~ /^[^\/]+$/);
242                            }
243                  } else {                  } else {
244                          $out{$f}++ if ($f =~ /^[^\/]+$/);                          $out{$f}++ if ($f =~ /^[^\/]+$/);
245                  }                  }
# Line 133  sub e_getdir { Line 247  sub e_getdir {
247          if (! %out) {          if (! %out) {
248                  $out{'no files? bug?'}++;                  $out{'no files? bug?'}++;
249          }          }
250          print scalar keys %out," files found for '$dirname': ",keys %out,"\n";          print scalar keys %out," files in dir '$dirname'\n";
251            print "## ",join(" ",keys %out),"\n";
252          return (keys %out),0;          return (keys %out),0;
253  }  }
254    
# Line 146  sub e_open { Line 261  sub e_open {
261          return -EISDIR() unless exists($files{$file}{id});          return -EISDIR() unless exists($files{$file}{id});
262    
263          if (!exists($files{$file}{cont})) {          if (!exists($files{$file}{cont})) {
264                  $sth_read->execute($files{$file}{id}) || die $sth_read->errstr;                  $sth->{'read'}->execute($files{$file}{id}) || die $sth->{'read'}->errstr;
265                  $files{$file}{cont} = $sth_read->fetchrow_array;                  $files{$file}{cont} = $sth->{'read'}->fetchrow_array;
266                  print "file '$file' content read in cache\n";                  print "file '$file' content read in cache\n";
267          }          }
268          print "open '$file' ",length($files{$file}{cont})," bytes\n";          print "open '$file' ",length($files{$file}{cont})," bytes\n";
# Line 159  sub e_read { Line 274  sub e_read {
274          # (note: 0 means EOF, "0" will give a byte (ascii "0")          # (note: 0 means EOF, "0" will give a byte (ascii "0")
275          # to the reading program)          # to the reading program)
276          my ($file) = filename_fixup(shift);          my ($file) = filename_fixup(shift);
277          my ($buf,$off) = @_;          my ($buf_len,$off) = @_;
278    
279          return -ENOENT() unless exists($files{$file});          return -ENOENT() unless exists($files{$file});
280    
281          my $len = length($files{$file}{cont});          my $len = length($files{$file}{cont});
282    
283          print "read '$file' [$len bytes] offset $off length $buf\n";          print "read '$file' [$len bytes] offset $off length $buf_len\n";
284    
285          return -EINVAL() if ($off > $len);          return -EINVAL() if ($off > $len);
286          return 0 if ($off == $len);          return 0 if ($off == $len);
287    
288          $buf = $len-$off if ($off+$buf > $len);          $buf_len = $buf_len-$off if ($off+$buf_len > $len);
289    
290          return substr($files{$file}{cont},$off,$buf);          return substr($files{$file}{cont},$off,$buf_len);
291  }  }
292    
293  sub clear_cont {  sub clear_cont {
# Line 190  sub clear_cont { Line 305  sub clear_cont {
305  sub update_db {  sub update_db {
306          my $file = shift || die;          my $file = shift || die;
307    
308          if (!$sth_update->execute($files{$file}{cont},$files{$file}{id})) {          $files{$file}{ctime} = time();
309                  print "update problem: ",$sth_update->errstr;  
310            if (!$sth->{'update'}->execute($files{$file}{cont},$files{$file}{id})) {
311                    print "update problem: ",$sth->{'update'}->errstr;
312                  clear_cont;                  clear_cont;
313                  return 0;                  return 0;
314          } else {          } else {
315                  if (! $dbh->commit) {                  if (! $dbh->commit) {
316                          print "ERROR: commit problem: ",$sth_update->errstr;                          print "ERROR: commit problem: ",$sth->{'update'}->errstr;
317                          clear_cont;                          clear_cont;
318                          return 0;                          return 0;
319                  }                  }
# Line 207  sub update_db { Line 324  sub update_db {
324    
325  sub e_write {  sub e_write {
326          my $file = filename_fixup(shift);          my $file = filename_fixup(shift);
327          my ($buf,$off) = @_;          my ($buf_len,$off) = @_;
328    
329          return -ENOENT() unless exists($files{$file});          return -ENOENT() unless exists($files{$file});
330    
331          my $len = length($files{$file}{cont});          my $len = length($files{$file}{cont});
332    
333          print "write '$file' [$len bytes] offset $off length $buf\n";          print "write '$file' [$len bytes] offset $off length\n";
334    
335          $files{$file}{cont} =          $files{$file}{cont} =
336                  substr($files{$file}{cont},0,$off) .                  substr($files{$file}{cont},0,$off) .
337                  $buf .                  $buf_len .
338                  substr($files{$file}{cont},$off+length($buf));                  substr($files{$file}{cont},$off+length($buf_len));
339    
340          if (! update_db($file)) {          if (! update_db($file)) {
341                  return -ENOSYS();                  return -ENOSYS();
342          } else {          } else {
343                  return length($buf);                  return length($buf_len);
344          }          }
345  }  }
346    
# Line 242  sub e_utime { Line 359  sub e_utime {
359    
360          return -ENOENT() unless exists($files{$file});          return -ENOENT() unless exists($files{$file});
361    
362            print "utime '$file' $atime $mtime\n";
363    
364          $files{$file}{time} = $mtime;          $files{$file}{time} = $mtime;
365          return 0;          return 0;
366  }  }
367    
368  sub e_statfs { return 255, 1, 1, 1, 1, 2 }  sub e_statfs { return 255, 1, 1, 1, 1, 2 }
369    
370  # If you run the script directly, it will run fusermount, which will in turn  1;
371  # re-run this script.  Hence the funky semantics.  __END__
372  my ($mountpoint) = "";  
373  $mountpoint = shift(@ARGV) if @ARGV;  =head1 EXPORT
374  Fuse::main(  
375          mountpoint=>$mountpoint,  Nothing.
376          getattr=>\&e_getattr,  
377          getdir=>\&e_getdir,  =head1 SEE ALSO
378          open=>\&e_open,  
379          statfs=>\&e_statfs,  C<FUSE (Filesystem in USErspace)> website
380          read=>\&e_read,  L<http://sourceforge.net/projects/avf>
381          write=>\&e_write,  
382          utime=>\&e_utime,  =head1 AUTHOR
383          truncate=>\&e_truncate,  
384          debug=>0,  Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
385  );  
386    =head1 COPYRIGHT AND LICENSE
387    
388    Copyright (C) 2004 by Dobrica Pavlinusic
389    
390    This library is free software; you can redistribute it and/or modify
391    it under the same terms as Perl itself, either Perl version 5.8.4 or,
392    at your option, any later version of Perl 5 you may have available.
393    
394    
395    =cut
396    
Legend:
Removed from v.7  
changed lines
  Added in v.13
  ViewVC Help
Powered by ViewVC 1.1.26