From: Dobrica Pavlinusic Date: Sat, 7 Aug 2004 19:06:03 +0000 (+0000) Subject: move code to Fuse::DBI module (probably broken now) X-Git-Url: http://git.rot13.org/?p=Fuse-DBI;a=commitdiff_plain;h=671e9e0cbc85e9bf0d289bf8561243447cf6459d move code to Fuse::DBI module (probably broken now) git-svn-id: svn://svn.rot13.org/fuse_dbi/trunk@9 17f4e80c-d0e0-0310-8903-bfc3ae804c12 --- diff --git a/Changes b/Changes new file mode 100644 index 0000000..c7b94d8 --- /dev/null +++ b/Changes @@ -0,0 +1,6 @@ +Revision history for Perl extension Fuse::DBI. + +0.01 Sat Aug 7 17:19:26 2004 + - original version; created by h2xs 1.23 with options + -AX -n Fuse::DBI -b 5.8.0 + diff --git a/DBI.pm b/DBI.pm new file mode 100755 index 0000000..572af5b --- /dev/null +++ b/DBI.pm @@ -0,0 +1,345 @@ +#!/usr/bin/perl + +package Fuse::DBI; + +use 5.008; +use strict; +use warnings; + +use POSIX qw(ENOENT EISDIR EINVAL ENOSYS O_RDWR); +use Fuse; +use DBI; + +our $VERSION = '0.01'; + +=head1 NAME + +Fuse::DBI - mount your database as filesystem and use it + +=head1 SYNOPSIS + + use Fuse::DBI; + Fuse::DBI->run( ... ); + +See L below for examples how to set parametars. + +=head1 DESCRIPTION + +This module will use L module, part of C +available at L to mount +your database as file system. + +That will give you posibility to use normal file-system tools (cat, grep, vi) +to manipulate data in database. + +It's actually opposite of Oracle's intention to put everything into database. + + +=head1 METHODS + +=cut + +=head2 run + +Mount your database as filesystem. + + Fuse::DBI->run({ + filenames => 'select name from filenamefilenames, + read => 'sql read', + update => 'sql update', + dsn => 'DBI:Pg:dbname=webgui', + user => 'database_user', + password => 'database_password' + }); + +=cut + +my $dbh; +my $sth; +my $ctime_start; + +sub run { + my $self = shift + + my $arg = {@_}; + + carp "run needs 'dsn' to connect to (e.g. dsn => 'DBI:Pg:dbname=test')" unless ($arg->{'dsn'}); + carp "run needs 'mount' as mountpoint" unless ($arg->{'mount'}); + + foreach (qw(filenames read update)) { + carp "run needs '$_' SQL" unless ($arg->{$_}); + } + + $dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, { AutoCommit => 0 }) || die $DBI::errstr; + + print "start transaction\n"; + #$dbh->begin_work || die $dbh->errstr; + + $sth->{filenames} = $dbh->prepare($arg->{'filenames'}) || die $dbh->errstr(); + + $sth->{'read'} = $dbh->prepare($arg->{'read'}) || die $dbh->errstr(); + $sth->{'update'} = $dbh->prepare($arg->{'update'}) || die $dbh->errstr(); + + $ctime_start = time(); + + read_filenames; + + Fuse::main( + mountpoint=>$arg->{'mount'}, + getattr=>\&e_getattr, + getdir=>\&e_getdir, + open=>\&e_open, + statfs=>\&e_statfs, + read=>\&e_read, + write=>\&e_write, + utime=>\&e_utime, + truncate=>\&e_truncate, + debug=>0, + ); +}; + +my %files; +my %dirs; + +sub read_filenames { + # create empty filesystem + (%files) = ( + '.' => { + type => 0040, + mode => 0755, + }, + # a => { + # cont => "File 'a'.\n", + # type => 0100, + # ctime => time()-2000 + # }, + ); + + # fetch new filename list from database + $sth->{'filenames'}->execute() || die $sth->{'filenames'}->errstr(); + + # read them in with sesible defaults + while (my $row = $sth->{'filenames'}->fetchrow_hashref() ) { + $files{$row->{'filename'}} = { + size => $row->{'size'}, + mode => $row->{'writable'} ? 0644 : 0444, + id => $row->{'id'} || 99, + }; + + my $d; + foreach (split(m!/!, $row->{'filename'})) { + # first, entry is assumed to be file + if ($d) { + $files{$d} = { + size => $dirs{$d}++, + mode => 0755, + type => 0040 + }; + $files{$d.'/.'} = { + mode => 0755, + type => 0040 + }; + $files{$d.'/..'} = { + mode => 0755, + type => 0040 + }; + } + $d .= "/" if ($d); + $d .= "$_"; + } + } + + print "found ",scalar(keys %files)-scalar(keys %dirs)," files, ",scalar(keys %dirs), " dirs\n"; +} + + +sub filename_fixup { + my ($file) = shift; + $file =~ s,^/,,; + $file = '.' unless length($file); + return $file; +} + +sub e_getattr { + my ($file) = filename_fixup(shift); + $file =~ s,^/,,; + $file = '.' unless length($file); + return -ENOENT() unless exists($files{$file}); + my ($size) = $files{$file}{size} || 1; + my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,1,0,0,1,1024); + my ($atime, $ctime, $mtime); + $atime = $ctime = $mtime = $files{$file}{ctime} || $ctime_start; + + my ($modes) = (($files{$file}{type} || 0100)<<9) + $files{$file}{mode}; + + # 2 possible types of return values: + #return -ENOENT(); # or any other error you care to + #print(join(",",($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)),"\n"); + return ($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks); +} + +sub e_getdir { + my ($dirname) = shift; + $dirname =~ s!^/!!; + # return as many text filenames as you like, followed by the retval. + print((scalar keys %files)." files total\n"); + my %out; + foreach (keys %files) { + my $f = $_; + $f =~ s/^\E$dirname\Q//; + $f =~ s/^\///; + if ($dirname) { + $out{$f}++ if (/^\E$dirname\Q/ && $f =~ /^[^\/]+$/); + } else { + $out{$f}++ if ($f =~ /^[^\/]+$/); + } + } + if (! %out) { + $out{'no files? bug?'}++; + } + print scalar keys %out," files in dir '$dirname'\n"; + return (keys %out),0; +} + +sub e_open { + # VFS sanity check; it keeps all the necessary state, not much to do here. + my $file = filename_fixup(shift); + my $flags = shift; + + return -ENOENT() unless exists($files{$file}); + return -EISDIR() unless exists($files{$file}{id}); + + if (!exists($files{$file}{cont})) { + $sth->{'read'}->execute($files{$file}{id}) || die $sth->{'read'}->errstr; + $files{$file}{cont} = $sth->{'read'}->fetchrow_array; + print "file '$file' content read in cache\n"; + } + print "open '$file' ",length($files{$file}{cont})," bytes\n"; + return 0; +} + +sub e_read { + # return an error numeric, or binary/text string. + # (note: 0 means EOF, "0" will give a byte (ascii "0") + # to the reading program) + my ($file) = filename_fixup(shift); + my ($buf_len,$off) = @_; + + return -ENOENT() unless exists($files{$file}); + + my $len = length($files{$file}{cont}); + + print "read '$file' [$len bytes] offset $off length $buf_len\n"; + + return -EINVAL() if ($off > $len); + return 0 if ($off == $len); + + $buf_len = $buf_len-$off if ($off+$buf_len > $len); + + return substr($files{$file}{cont},$off,$buf_len); +} + +sub clear_cont { + print "transaction rollback\n"; + $dbh->rollback || die $dbh->errstr; + print "invalidate all cached content\n"; + foreach my $f (keys %files) { + delete $files{$f}{cont}; + } + print "begin new transaction\n"; + $dbh->begin_work || die $dbh->errstr; +} + + +sub update_db { + my $file = shift || die; + + $files{$file}{ctime} = time(); + + if (!$sth->{'update'}->execute($files{$file}{cont},$files{$file}{id})) { + print "update problem: ",$sth->{'update'}->errstr; + clear_cont; + return 0; + } else { + if (! $dbh->commit) { + print "ERROR: commit problem: ",$sth->{'update'}->errstr; + clear_cont; + return 0; + } + print "updated '$file' [",$files{$file}{id},"]\n"; + } + return 1; +} + +sub e_write { + my $file = filename_fixup(shift); + my ($buf_len,$off) = @_; + + return -ENOENT() unless exists($files{$file}); + + my $len = length($files{$file}{cont}); + + print "write '$file' [$len bytes] offset $off length\n"; + + $files{$file}{cont} = + substr($files{$file}{cont},0,$off) . + $buf_len . + substr($files{$file}{cont},$off+length($buf_len)); + + if (! update_db($file)) { + return -ENOSYS(); + } else { + return length($buf_len); + } +} + +sub e_truncate { + my $file = filename_fixup(shift); + my $size = shift; + + $files{$file}{cont} = substr($files{$file}{cont},0,$size); + return 0 +}; + + +sub e_utime { + my ($atime,$mtime,$file) = @_; + $file = filename_fixup($file); + + return -ENOENT() unless exists($files{$file}); + + print "utime '$file' $atime $mtime\n"; + + $files{$file}{time} = $mtime; + return 0; +} + +sub e_statfs { return 255, 1, 1, 1, 1, 2 } + +1; +__END__ + +=head1 EXPORT + +Nothing. + +=head1 SEE ALSO + +C website +L + +=head1 AUTHOR + +Dobrica Pavlinusic, Edpavlin@rot13.orgE + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2004 by Dobrica Pavlinusic + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.8.4 or, +at your option, any later version of Perl 5 you may have available. + + +=cut + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..ee6da89 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,8 @@ +Changes +Makefile.PL +MANIFEST +README +DBI.pm +t/01load.t +t/99pod.t +examples/webgui.pl diff --git a/Makefile b/Makefile index a09d827..ec479b4 100644 --- a/Makefile +++ b/Makefile @@ -1,8 +1,728 @@ -all: +# This Makefile is for the Fuse::DBI extension to perl. +# +# It was generated automatically by MakeMaker version +# 6.17 (Revision: 1.133) from the contents of +# Makefile.PL. Don't edit this file, edit Makefile.PL instead. +# +# ANY CHANGES MADE HERE WILL BE LOST! +# +# MakeMaker ARGV: () +# +# MakeMaker Parameters: + +# ABSTRACT_FROM => q[lib/Fuse/DBI.pm] +# AUTHOR => q[Dobrica Pavlinusic ] +# NAME => q[Fuse::DBI] +# PREREQ_PM => { POSIX=>q[0], Fuse=>q[0] } +# VERSION_FROM => q[DBI.pm] + +# --- MakeMaker post_initialize section: + + +# --- MakeMaker const_config section: + +# These definitions are from config.sh (via /usr/lib/perl/5.8/Config.pm) + +# They may have been overridden via Makefile.PL or on the command line +AR = ar +CC = cc +CCCDLFLAGS = -fPIC +CCDLFLAGS = -Wl,-E +DLEXT = so +DLSRC = dl_dlopen.xs +LD = cc +LDDLFLAGS = -shared -L/usr/local/lib +LDFLAGS = -L/usr/local/lib +LIBC = /lib/libc-2.3.2.so +LIB_EXT = .a +OBJ_EXT = .o +OSNAME = linux +OSVERS = 2.4.26-ti1211 +RANLIB = : +SITELIBEXP = /usr/local/share/perl/5.8.4 +SITEARCHEXP = /usr/local/lib/perl/5.8.4 +SO = so +EXE_EXT = +FULL_AR = /usr/bin/ar +VENDORARCHEXP = /usr/lib/perl5 +VENDORLIBEXP = /usr/share/perl5 + + +# --- MakeMaker constants section: +AR_STATIC_ARGS = cr +DIRFILESEP = / +NAME = Fuse::DBI +NAME_SYM = Fuse_DBI +VERSION = 0.01 +VERSION_MACRO = VERSION +VERSION_SYM = 0_01 +DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\" +XS_VERSION = 0.01 +XS_VERSION_MACRO = XS_VERSION +XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\" +INST_ARCHLIB = blib/arch +INST_SCRIPT = blib/script +INST_BIN = blib/bin +INST_LIB = blib/lib +INST_MAN1DIR = blib/man1 +INST_MAN3DIR = blib/man3 +MAN1EXT = 1p +MAN3EXT = 3pm +INSTALLDIRS = site +DESTDIR = +PREFIX = /usr +PERLPREFIX = $(PREFIX) +SITEPREFIX = $(PREFIX)/local +VENDORPREFIX = $(PREFIX) +INSTALLPRIVLIB = $(PERLPREFIX)/share/perl/5.8 +DESTINSTALLPRIVLIB = $(DESTDIR)$(INSTALLPRIVLIB) +INSTALLSITELIB = $(SITEPREFIX)/share/perl/5.8.4 +DESTINSTALLSITELIB = $(DESTDIR)$(INSTALLSITELIB) +INSTALLVENDORLIB = $(VENDORPREFIX)/share/perl5 +DESTINSTALLVENDORLIB = $(DESTDIR)$(INSTALLVENDORLIB) +INSTALLARCHLIB = $(PERLPREFIX)/lib/perl/5.8 +DESTINSTALLARCHLIB = $(DESTDIR)$(INSTALLARCHLIB) +INSTALLSITEARCH = $(SITEPREFIX)/lib/perl/5.8.4 +DESTINSTALLSITEARCH = $(DESTDIR)$(INSTALLSITEARCH) +INSTALLVENDORARCH = $(VENDORPREFIX)/lib/perl5 +DESTINSTALLVENDORARCH = $(DESTDIR)$(INSTALLVENDORARCH) +INSTALLBIN = $(PERLPREFIX)/bin +DESTINSTALLBIN = $(DESTDIR)$(INSTALLBIN) +INSTALLSITEBIN = $(SITEPREFIX)/bin +DESTINSTALLSITEBIN = $(DESTDIR)$(INSTALLSITEBIN) +INSTALLVENDORBIN = $(VENDORPREFIX)/bin +DESTINSTALLVENDORBIN = $(DESTDIR)$(INSTALLVENDORBIN) +INSTALLSCRIPT = $(PERLPREFIX)/bin +DESTINSTALLSCRIPT = $(DESTDIR)$(INSTALLSCRIPT) +INSTALLMAN1DIR = $(PERLPREFIX)/share/man/man1 +DESTINSTALLMAN1DIR = $(DESTDIR)$(INSTALLMAN1DIR) +INSTALLSITEMAN1DIR = $(SITEPREFIX)/man/man1 +DESTINSTALLSITEMAN1DIR = $(DESTDIR)$(INSTALLSITEMAN1DIR) +INSTALLVENDORMAN1DIR = $(VENDORPREFIX)/share/man/man1 +DESTINSTALLVENDORMAN1DIR = $(DESTDIR)$(INSTALLVENDORMAN1DIR) +INSTALLMAN3DIR = $(PERLPREFIX)/share/man/man3 +DESTINSTALLMAN3DIR = $(DESTDIR)$(INSTALLMAN3DIR) +INSTALLSITEMAN3DIR = $(SITEPREFIX)/man/man3 +DESTINSTALLSITEMAN3DIR = $(DESTDIR)$(INSTALLSITEMAN3DIR) +INSTALLVENDORMAN3DIR = $(VENDORPREFIX)/share/man/man3 +DESTINSTALLVENDORMAN3DIR = $(DESTDIR)$(INSTALLVENDORMAN3DIR) +PERL_LIB = /usr/share/perl/5.8 +PERL_ARCHLIB = /usr/lib/perl/5.8 +LIBPERL_A = libperl.a +FIRST_MAKEFILE = Makefile +MAKEFILE_OLD = $(FIRST_MAKEFILE).old +MAKE_APERL_FILE = $(FIRST_MAKEFILE).aperl +PERLMAINCC = $(CC) +PERL_INC = /usr/lib/perl/5.8/CORE +PERL = /usr/bin/perl +FULLPERL = /usr/bin/perl +ABSPERL = $(PERL) +PERLRUN = $(PERL) +FULLPERLRUN = $(FULLPERL) +ABSPERLRUN = $(ABSPERL) +PERLRUNINST = $(PERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +FULLPERLRUNINST = $(FULLPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +ABSPERLRUNINST = $(ABSPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" +PERL_CORE = 0 +PERM_RW = 644 +PERM_RWX = 755 + +MAKEMAKER = /usr/share/perl/5.8/ExtUtils/MakeMaker.pm +MM_VERSION = 6.17 +MM_REVISION = 1.133 + +# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle). +# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle) +# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar) +# DLBASE = Basename part of dynamic library. May be just equal BASEEXT. +FULLEXT = Fuse/DBI +BASEEXT = DBI +PARENT_NAME = Fuse +DLBASE = $(BASEEXT) +VERSION_FROM = DBI.pm +OBJECT = +LDFROM = $(OBJECT) +LINKTYPE = dynamic + +# Handy lists of source code files: +XS_FILES = +C_FILES = +O_FILES = +H_FILES = +MAN1PODS = +MAN3PODS = DBI.pm \ + lib/Fuse/DBI.pm + +# Where is the Config information that we are using/depend on +CONFIGDEP = $(PERL_ARCHLIB)$(DIRFILESEP)Config.pm $(PERL_INC)$(DIRFILESEP)config.h + +# Where to build things +INST_LIBDIR = $(INST_LIB)/Fuse +INST_ARCHLIBDIR = $(INST_ARCHLIB)/Fuse + +INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT) +INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT) + +INST_STATIC = +INST_DYNAMIC = +INST_BOOT = + +# Extra linker info +EXPORT_LIST = +PERL_ARCHIVE = +PERL_ARCHIVE_AFTER = + + +TO_INST_PM = DBI.pm \ + lib/Fuse/DBI.pm + +PM_TO_BLIB = DBI.pm \ + $(INST_LIB)/Fuse/DBI.pm \ + lib/Fuse/DBI.pm \ + blib/lib/Fuse/DBI.pm + + +# --- MakeMaker platform_constants section: +MM_Unix_VERSION = 1.42 +PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc + + +# --- MakeMaker tool_autosplit section: +# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto +AUTOSPLITFILE = $(PERLRUN) -e 'use AutoSplit; autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1)' + + + +# --- MakeMaker tool_xsubpp section: + + +# --- MakeMaker tools_other section: +SHELL = /bin/sh +CHMOD = chmod +CP = cp +MV = mv +NOOP = $(SHELL) -c true +NOECHO = @ +RM_F = rm -f +RM_RF = rm -rf +TEST_F = test -f +TOUCH = touch +UMASK_NULL = umask 0 +DEV_NULL = > /dev/null 2>&1 +MKPATH = $(PERLRUN) "-MExtUtils::Command" -e mkpath +EQUALIZE_TIMESTAMP = $(PERLRUN) "-MExtUtils::Command" -e eqtime +ECHO = echo +ECHO_N = echo -n +UNINST = 0 +VERBINST = 0 +MOD_INSTALL = $(PERLRUN) -MExtUtils::Install -e 'install({@ARGV}, '\''$(VERBINST)'\'', 0, '\''$(UNINST)'\'');' +DOC_INSTALL = $(PERLRUN) "-MExtUtils::Command::MM" -e perllocal_install +UNINSTALL = $(PERLRUN) "-MExtUtils::Command::MM" -e uninstall +WARN_IF_OLD_PACKLIST = $(PERLRUN) "-MExtUtils::Command::MM" -e warn_if_old_packlist + + +# --- MakeMaker makemakerdflt section: +makemakerdflt: all + $(NOECHO) $(NOOP) + + +# --- MakeMaker dist section: +TAR = tar +TARFLAGS = cvf +ZIP = zip +ZIPFLAGS = -r +COMPRESS = gzip --best +SUFFIX = .gz +SHAR = shar +PREOP = $(NOECHO) $(NOOP) +POSTOP = $(NOECHO) $(NOOP) +TO_UNIX = $(NOECHO) $(NOOP) +CI = ci -u +RCS_LABEL = rcs -Nv$(VERSION_SYM): -q +DIST_CP = best +DIST_DEFAULT = tardist +DISTNAME = Fuse-DBI +DISTVNAME = Fuse-DBI-0.01 + + +# --- MakeMaker macro section: + + +# --- MakeMaker depend section: + + +# --- MakeMaker cflags section: + + +# --- MakeMaker const_loadlibs section: + + +# --- MakeMaker const_cccmd section: + + +# --- MakeMaker post_constants section: + + +# --- MakeMaker pasthru section: + +PASTHRU = LIB="$(LIB)"\ + LIBPERL_A="$(LIBPERL_A)"\ + LINKTYPE="$(LINKTYPE)"\ + PREFIX="$(PREFIX)"\ + OPTIMIZE="$(OPTIMIZE)"\ + PASTHRU_DEFINE="$(PASTHRU_DEFINE)"\ + PASTHRU_INC="$(PASTHRU_INC)" + + +# --- MakeMaker special_targets section: +.SUFFIXES: .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT) + +.PHONY: all config static dynamic test linkext manifest + + + +# --- MakeMaker c_o section: + + +# --- MakeMaker xs_c section: + + +# --- MakeMaker xs_o section: + + +# --- MakeMaker top_targets section: +all :: pure_all manifypods + $(NOECHO) $(NOOP) + + +pure_all :: config pm_to_blib subdirs linkext + $(NOECHO) $(NOOP) + +subdirs :: $(MYEXTLIB) + $(NOECHO) $(NOOP) + +config :: $(FIRST_MAKEFILE) $(INST_LIBDIR)$(DIRFILESEP).exists + $(NOECHO) $(NOOP) + +config :: $(INST_ARCHAUTODIR)$(DIRFILESEP).exists + $(NOECHO) $(NOOP) + +config :: $(INST_AUTODIR)$(DIRFILESEP).exists + $(NOECHO) $(NOOP) + +$(INST_AUTODIR)/.exists :: /usr/lib/perl/5.8/CORE/perl.h + $(NOECHO) $(MKPATH) $(INST_AUTODIR) + $(NOECHO) $(EQUALIZE_TIMESTAMP) /usr/lib/perl/5.8/CORE/perl.h $(INST_AUTODIR)/.exists + + -$(NOECHO) $(CHMOD) $(PERM_RWX) $(INST_AUTODIR) + +$(INST_LIBDIR)/.exists :: /usr/lib/perl/5.8/CORE/perl.h + $(NOECHO) $(MKPATH) $(INST_LIBDIR) + $(NOECHO) $(EQUALIZE_TIMESTAMP) /usr/lib/perl/5.8/CORE/perl.h $(INST_LIBDIR)/.exists + + -$(NOECHO) $(CHMOD) $(PERM_RWX) $(INST_LIBDIR) + +$(INST_ARCHAUTODIR)/.exists :: /usr/lib/perl/5.8/CORE/perl.h + $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR) + $(NOECHO) $(EQUALIZE_TIMESTAMP) /usr/lib/perl/5.8/CORE/perl.h $(INST_ARCHAUTODIR)/.exists + + -$(NOECHO) $(CHMOD) $(PERM_RWX) $(INST_ARCHAUTODIR) + +config :: $(INST_MAN3DIR)$(DIRFILESEP).exists + $(NOECHO) $(NOOP) + + +$(INST_MAN3DIR)/.exists :: /usr/lib/perl/5.8/CORE/perl.h + $(NOECHO) $(MKPATH) $(INST_MAN3DIR) + $(NOECHO) $(EQUALIZE_TIMESTAMP) /usr/lib/perl/5.8/CORE/perl.h $(INST_MAN3DIR)/.exists + + -$(NOECHO) $(CHMOD) $(PERM_RWX) $(INST_MAN3DIR) + +help: + perldoc ExtUtils::MakeMaker + + +# --- MakeMaker linkext section: + +linkext :: $(LINKTYPE) + $(NOECHO) $(NOOP) + + +# --- MakeMaker dlsyms section: + + +# --- MakeMaker dynamic section: + +dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT) + $(NOECHO) $(NOOP) + + +# --- MakeMaker dynamic_bs section: + +BOOTSTRAP = + + +# --- MakeMaker dynamic_lib section: + + +# --- MakeMaker static section: + +## $(INST_PM) has been moved to the all: target. +## It remains here for awhile to allow for old usage: "make static" +static :: $(FIRST_MAKEFILE) $(INST_STATIC) + $(NOECHO) $(NOOP) + + +# --- MakeMaker static_lib section: + + +# --- MakeMaker manifypods section: + +POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--" +POD2MAN = $(POD2MAN_EXE) + + +manifypods : pure_all \ + DBI.pm \ + lib/Fuse/DBI.pm \ + DBI.pm \ + lib/Fuse/DBI.pm + $(NOECHO) $(POD2MAN) --section=3pm --perm_rw=$(PERM_RW)\ + DBI.pm $(INST_MAN3DIR)/Fuse::DBI.$(MAN3EXT) \ + lib/Fuse/DBI.pm $(INST_MAN3DIR)/Fuse::DBI.$(MAN3EXT) + + + + +# --- MakeMaker processPL section: + + +# --- MakeMaker installbin section: + + +# --- MakeMaker subdirs section: + +# none + +# --- MakeMaker clean_subdirs section: +clean_subdirs : + $(NOECHO) $(NOOP) + + +# --- MakeMaker clean section: + +# Delete temporary files but do not touch installed files. We don't delete +# the Makefile here so a later make realclean still has a makefile to use. + +clean :: clean_subdirs + -$(RM_RF) ./blib $(MAKE_APERL_FILE) $(INST_ARCHAUTODIR)/extralibs.all $(INST_ARCHAUTODIR)/extralibs.ld perlmain.c tmon.out mon.out so_locations pm_to_blib *$(OBJ_EXT) *$(LIB_EXT) perl.exe perl perl$(EXE_EXT) $(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def lib$(BASEEXT).def $(BASEEXT).exp $(BASEEXT).x core core.*perl.*.? *perl.core core.[0-9] core.[0-9][0-9] core.[0-9][0-9][0-9] core.[0-9][0-9][0-9][0-9] core.[0-9][0-9][0-9][0-9][0-9] + -$(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL) + + +# --- MakeMaker realclean_subdirs section: +realclean_subdirs : + $(NOECHO) $(NOOP) + + +# --- MakeMaker realclean section: + +# Delete temporary files (via clean) and also delete installed files +realclean purge :: clean realclean_subdirs + $(RM_RF) $(INST_AUTODIR) $(INST_ARCHAUTODIR) + $(RM_RF) $(DISTVNAME) + $(RM_F) blib/lib/Fuse/DBI.pm $(INST_LIB)/Fuse/DBI.pm $(MAKEFILE_OLD) $(FIRST_MAKEFILE) + + +# --- MakeMaker metafile section: +metafile : + $(NOECHO) $(ECHO) '# http://module-build.sourceforge.net/META-spec.html' > META.yml + $(NOECHO) $(ECHO) '#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#' >> META.yml + $(NOECHO) $(ECHO) 'name: Fuse-DBI' >> META.yml + $(NOECHO) $(ECHO) 'version: 0.01' >> META.yml + $(NOECHO) $(ECHO) 'version_from: DBI.pm' >> META.yml + $(NOECHO) $(ECHO) 'installdirs: site' >> META.yml + $(NOECHO) $(ECHO) 'requires:' >> META.yml + $(NOECHO) $(ECHO) ' Fuse: 0' >> META.yml + $(NOECHO) $(ECHO) ' POSIX: 0' >> META.yml + $(NOECHO) $(ECHO) '' >> META.yml + $(NOECHO) $(ECHO) 'distribution_type: module' >> META.yml + $(NOECHO) $(ECHO) 'generated_by: ExtUtils::MakeMaker version 6.17' >> META.yml + + +# --- MakeMaker metafile_addtomanifest section: +metafile_addtomanifest: + $(NOECHO) $(PERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{META.yml} => q{Module meta-data (added by MakeMaker)}}) } ' \ + -e ' or print "Could not add META.yml to MANIFEST: $${'\''@'\''}\n"' + + +# --- MakeMaker dist_basics section: +distclean :: realclean distcheck + $(NOECHO) $(NOOP) + +distcheck : + $(PERLRUN) "-MExtUtils::Manifest=fullcheck" -e fullcheck + +skipcheck : + $(PERLRUN) "-MExtUtils::Manifest=skipcheck" -e skipcheck + +manifest : + $(PERLRUN) "-MExtUtils::Manifest=mkmanifest" -e mkmanifest + +veryclean : realclean + $(RM_F) *~ *.orig */*~ */*.orig + + + +# --- MakeMaker dist_core section: + +dist : $(DIST_DEFAULT) $(FIRST_MAKEFILE) + $(NOECHO) $(PERLRUN) -l -e 'print '\''Warning: Makefile possibly out of date with $(VERSION_FROM)'\''' \ + -e ' if -e '\''$(VERSION_FROM)'\'' and -M '\''$(VERSION_FROM)'\'' < -M '\''$(FIRST_MAKEFILE)'\'';' + +tardist : $(DISTVNAME).tar$(SUFFIX) + $(NOECHO) $(NOOP) + +uutardist : $(DISTVNAME).tar$(SUFFIX) + uuencode $(DISTVNAME).tar$(SUFFIX) $(DISTVNAME).tar$(SUFFIX) > $(DISTVNAME).tar$(SUFFIX)_uu + +$(DISTVNAME).tar$(SUFFIX) : distdir + $(PREOP) + $(TO_UNIX) + $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME) + $(RM_RF) $(DISTVNAME) + $(COMPRESS) $(DISTVNAME).tar + $(POSTOP) + +zipdist : $(DISTVNAME).zip + $(NOECHO) $(NOOP) + +$(DISTVNAME).zip : distdir + $(PREOP) + $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME) + $(RM_RF) $(DISTVNAME) + $(POSTOP) + +shdist : distdir + $(PREOP) + $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar + $(RM_RF) $(DISTVNAME) + $(POSTOP) + + +# --- MakeMaker distdir section: +distdir : metafile metafile_addtomanifest + $(RM_RF) $(DISTVNAME) + $(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \ + -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');" + + + +# --- MakeMaker dist_test section: + +disttest : distdir + cd $(DISTVNAME) && $(ABSPERLRUN) Makefile.PL + cd $(DISTVNAME) && $(MAKE) $(PASTHRU) + cd $(DISTVNAME) && $(MAKE) test $(PASTHRU) + + +# --- MakeMaker dist_ci section: + +ci : + $(PERLRUN) "-MExtUtils::Manifest=maniread" \ + -e "@all = keys %{ maniread() };" \ + -e "print(qq{Executing $(CI) @all\n}); system(qq{$(CI) @all});" \ + -e "print(qq{Executing $(RCS_LABEL) ...\n}); system(qq{$(RCS_LABEL) @all});" + + +# --- MakeMaker install section: + +install :: all pure_install doc_install + +install_perl :: all pure_perl_install doc_perl_install + +install_site :: all pure_site_install doc_site_install + +install_vendor :: all pure_vendor_install doc_vendor_install + +pure_install :: pure_$(INSTALLDIRS)_install + +doc_install :: doc_$(INSTALLDIRS)_install + +pure__install : pure_site_install + $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site + +doc__install : doc_site_install + $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site + +pure_perl_install :: + $(NOECHO) umask 022; $(MOD_INSTALL) \ + $(INST_LIB) $(DESTINSTALLPRIVLIB) \ + $(INST_ARCHLIB) $(DESTINSTALLARCHLIB) \ + $(INST_BIN) $(DESTINSTALLBIN) \ + $(INST_SCRIPT) $(DESTINSTALLSCRIPT) \ + $(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) \ + $(INST_MAN3DIR) $(DESTINSTALLMAN3DIR) + $(NOECHO) $(WARN_IF_OLD_PACKLIST) \ + $(SITEARCHEXP)/auto/$(FULLEXT) + + +pure_site_install :: + $(NOECHO) umask 02; $(MOD_INSTALL) \ + read $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist \ + write $(DESTINSTALLSITEARCH)/auto/$(FULLEXT)/.packlist \ + $(INST_LIB) $(DESTINSTALLSITELIB) \ + $(INST_ARCHLIB) $(DESTINSTALLSITEARCH) \ + $(INST_BIN) $(DESTINSTALLSITEBIN) \ + $(INST_SCRIPT) $(DESTINSTALLSCRIPT) \ + $(INST_MAN1DIR) $(DESTINSTALLSITEMAN1DIR) \ + $(INST_MAN3DIR) $(DESTINSTALLSITEMAN3DIR) + $(NOECHO) $(WARN_IF_OLD_PACKLIST) \ + $(PERL_ARCHLIB)/auto/$(FULLEXT) + +pure_vendor_install :: + $(NOECHO) umask 022; $(MOD_INSTALL) \ + $(INST_LIB) $(DESTINSTALLVENDORLIB) \ + $(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) \ + $(INST_BIN) $(DESTINSTALLVENDORBIN) \ + $(INST_SCRIPT) $(DESTINSTALLSCRIPT) \ + $(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) \ + $(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR) + +doc_perl_install :: + +doc_site_install :: + $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLSITEARCH)/perllocal.pod + -$(NOECHO) umask 02; $(MKPATH) $(DESTINSTALLSITEARCH) + -$(NOECHO) umask 02; $(DOC_INSTALL) \ + "Module" "$(NAME)" \ + "installed into" "$(INSTALLSITELIB)" \ + LINKTYPE "$(LINKTYPE)" \ + VERSION "$(VERSION)" \ + EXE_FILES "$(EXE_FILES)" \ + >> $(DESTINSTALLSITEARCH)/perllocal.pod + +doc_vendor_install :: + + +uninstall :: uninstall_from_$(INSTALLDIRS)dirs + +uninstall_from_perldirs :: + $(NOECHO) $(UNINSTALL) $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist + +uninstall_from_sitedirs :: + $(NOECHO) $(UNINSTALL) $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist + +uninstall_from_vendordirs :: + $(NOECHO) $(UNINSTALL) $(VENDORARCHEXP)/auto/$(FULLEXT)/.packlist + + +# --- MakeMaker force section: +# Phony target to force checking subdirectories. +FORCE: + $(NOECHO) $(NOOP) + + +# --- MakeMaker perldepend section: + + +# --- MakeMaker makefile section: + +# We take a very conservative approach here, but it's worth it. +# We move Makefile to Makefile.old here to avoid gnu make looping. +$(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP) + $(NOECHO) $(ECHO) "Makefile out-of-date with respect to $?" + $(NOECHO) $(ECHO) "Cleaning current config before rebuilding Makefile..." + $(NOECHO) $(RM_F) $(MAKEFILE_OLD) + $(NOECHO) $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) + -$(MAKE) -f $(MAKEFILE_OLD) clean $(DEV_NULL) || $(NOOP) + $(PERLRUN) Makefile.PL + $(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <==" + $(NOECHO) $(ECHO) "==> Please rerun the make command. <==" + false + + + +# --- MakeMaker staticmake section: + +# --- MakeMaker makeaperl section --- +MAP_TARGET = perl +FULLPERL = /usr/bin/perl + +$(MAP_TARGET) :: static $(MAKE_APERL_FILE) + $(MAKE) -f $(MAKE_APERL_FILE) $@ + +$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) + $(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET) + $(NOECHO) $(PERLRUNINST) \ + Makefile.PL DIR= \ + MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \ + MAKEAPERL=1 NORECURS=1 CCCDLFLAGS= + + +# --- MakeMaker test section: + +TEST_VERBOSE=0 +TEST_TYPE=test_$(LINKTYPE) +TEST_FILE = test.pl +TEST_FILES = t/*.t +TESTDB_SW = -d + +testdb :: testdb_$(LINKTYPE) + +test :: $(TEST_TYPE) + +test_dynamic :: pure_all + PERL_DL_NONLAZY=1 $(FULLPERLRUN) "-MExtUtils::Command::MM" "-e" "test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES) + +testdb_dynamic :: pure_all + PERL_DL_NONLAZY=1 $(FULLPERLRUN) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE) + +test_ : test_dynamic + +test_static :: test_dynamic +testdb_static :: testdb_dynamic + + +# --- MakeMaker ppd section: +# Creates a PPD (Perl Package Description) for a binary distribution. +ppd: + $(NOECHO) $(ECHO) '' > $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' $(DISTNAME)' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' mount your database as filesystem and use it' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' Dobrica Pavlinusic <dpavlin@rot13.org>' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' ' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) '' >> $(DISTNAME).ppd + + +# --- MakeMaker pm_to_blib section: + +pm_to_blib: $(TO_INST_PM) + $(NOECHO) $(PERLRUN) -MExtUtils::Install -e 'pm_to_blib({@ARGV}, '\''$(INST_LIB)/auto'\'', '\''$(PM_FILTER)'\'')'\ + DBI.pm $(INST_LIB)/Fuse/DBI.pm \ + lib/Fuse/DBI.pm blib/lib/Fuse/DBI.pm + $(NOECHO) $(TOUCH) $@ + +# --- MakeMaker selfdocument section: + + +# --- MakeMaker postamble section: + +mount: + mkdir -f /tmp/db sudo modprobe fuse - sudo umount /mnt2 || exit 0 - ./fuse_dbi.pl /mnt2 - sudo umount /mnt2 + sudo umount /tmp/db || exit 0 + ./fuse_dbi.pl /tmp/db + sudo umount /tmp/db + +html: DBI.pm + pod2html DBI.pm > DBI.html && rm pod2htm?.tmp + + -test: - psql -q -t -A -c "select template from template where oid=3035699" webgui > foo +# End. diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..21fa72f --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,31 @@ +use 5.008; +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + NAME => 'Fuse::DBI', + VERSION_FROM => 'DBI.pm', # finds $VERSION + PREREQ_PM => { + Fuse => 0, + POSIX => 0, + }, # e.g., Module::Name => 1.1 + ($] >= 5.005 ? ## Add these new keywords supported since 5.005 + (ABSTRACT_FROM => 'lib/Fuse/DBI.pm', # retrieve abstract from module + AUTHOR => 'Dobrica Pavlinusic ') : ()), +); + +sub MY::postamble { + return <<'MAKE_MORE'; + +mount: + mkdir -f /tmp/db + sudo modprobe fuse + sudo umount /tmp/db || exit 0 + ./fuse_dbi.pl /tmp/db + sudo umount /tmp/db + +html: DBI.pm + pod2html DBI.pm > DBI.html && rm pod2htm?.tmp + +MAKE_MORE +} diff --git a/README b/README new file mode 100644 index 0000000..40183f9 --- /dev/null +++ b/README @@ -0,0 +1,29 @@ +Fuse-DBI version 0.01 +===================== + +Type perldoc Fuse::DBI to get instructions + +INSTALLATION + +To install this module type the following: + + perl Makefile.PL + make + make test + make install + +DEPENDENCIES + +This module requires these other modules and libraries: + + FIX + +COPYRIGHT AND LICENCE + +Copyright (C) 2004 by Dobrica Pavlinusic + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.8.4 or, +at your option, any later version of Perl 5 you may have available. + + diff --git a/fuse_dbi.pl b/fuse_dbi.pl deleted file mode 100755 index e4570bf..0000000 --- a/fuse_dbi.pl +++ /dev/null @@ -1,270 +0,0 @@ -#!/usr/bin/perl - -use POSIX qw(ENOENT EISDIR EINVAL ENOSYS O_RDWR); -use Fuse; - -use DBI; -use strict; - -my $sql_filenames = q{ - select - oid as id, - namespace||'/'||name||' ['||oid||']' as filename, - length(template) as size, - iseditable as writable - from template ; -}; - -my $sql_read = q{ - select template - from template - where oid = ?; -}; - -my $sql_update = q{ - update template - set template = ? - where oid = ?; -}; - - -my $connect = "DBI:Pg:dbname=webgui"; - -my $dbh = DBI->connect($connect,"","", { AutoCommit => 0 }) || die $DBI::errstr; - -print "start transaction\n"; -#$dbh->begin_work || die $dbh->errstr; - -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 -# }, -); - -my %dirs; - -while (my $row = $sth_filenames->fetchrow_hashref() ) { - $files{$row->{'filename'}} = { - size => $row->{'size'}, - mode => $row->{'writable'} ? 0644 : 0444, - id => $row->{'id'} || 99, - }; - - my $d; - foreach (split(m!/!, $row->{'filename'})) { - # first, entry is assumed to be file - if ($d) { - $files{$d} = { - size => $dirs{$d}++, - mode => 0755, - type => 0040 - }; - $files{$d.'/.'} = { - mode => 0755, - type => 0040 - }; - $files{$d.'/..'} = { - mode => 0755, - type => 0040 - }; - } - $d .= "/" if ($d); - $d .= "$_"; - } -} - -print "found ",scalar(keys %files)-scalar(keys %dirs)," files, ",scalar(keys %dirs), " dirs\n"; - -sub filename_fixup { - my ($file) = shift; - $file =~ s,^/,,; - $file = '.' unless length($file); - return $file; -} - -sub e_getattr { - my ($file) = filename_fixup(shift); - $file =~ s,^/,,; - $file = '.' unless length($file); - return -ENOENT() unless exists($files{$file}); - my ($size) = $files{$file}{size} || 1; - my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,1,0,0,1,1024); - my ($atime, $ctime, $mtime); - $atime = $ctime = $mtime = $files{$file}{ctime} || $ctime_start; - - my ($modes) = (($files{$file}{type} || 0100)<<9) + $files{$file}{mode}; - - # 2 possible types of return values: - #return -ENOENT(); # or any other error you care to - #print(join(",",($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)),"\n"); - return ($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks); -} - -sub e_getdir { - my ($dirname) = shift; - $dirname =~ s!^/!!; - # return as many text filenames as you like, followed by the retval. - print((scalar keys %files)." files total\n"); - my %out; - foreach (keys %files) { - my $f = $_; - $f =~ s/^\E$dirname\Q//; - $f =~ s/^\///; - if ($dirname) { - $out{$f}++ if (/^\E$dirname\Q/ && $f =~ /^[^\/]+$/); - } else { - $out{$f}++ if ($f =~ /^[^\/]+$/); - } - } - if (! %out) { - $out{'no files? bug?'}++; - } - print scalar keys %out," files in dir '$dirname'\n"; - return (keys %out),0; -} - -sub e_open { - # VFS sanity check; it keeps all the necessary state, not much to do here. - my $file = filename_fixup(shift); - my $flags = shift; - - return -ENOENT() unless exists($files{$file}); - return -EISDIR() unless exists($files{$file}{id}); - - if (!exists($files{$file}{cont})) { - $sth_read->execute($files{$file}{id}) || die $sth_read->errstr; - $files{$file}{cont} = $sth_read->fetchrow_array; - print "file '$file' content read in cache\n"; - } - print "open '$file' ",length($files{$file}{cont})," bytes\n"; - return 0; -} - -sub e_read { - # return an error numeric, or binary/text string. - # (note: 0 means EOF, "0" will give a byte (ascii "0") - # to the reading program) - my ($file) = filename_fixup(shift); - my ($buf_len,$off) = @_; - - return -ENOENT() unless exists($files{$file}); - - my $len = length($files{$file}{cont}); - - print "read '$file' [$len bytes] offset $off length $buf_len\n"; - - return -EINVAL() if ($off > $len); - return 0 if ($off == $len); - - $buf_len = $buf_len-$off if ($off+$buf_len > $len); - - return substr($files{$file}{cont},$off,$buf_len); -} - -sub clear_cont { - print "transaction rollback\n"; - $dbh->rollback || die $dbh->errstr; - print "invalidate all cached content\n"; - foreach my $f (keys %files) { - delete $files{$f}{cont}; - } - print "begin new transaction\n"; - $dbh->begin_work || die $dbh->errstr; -} - - -sub update_db { - my $file = shift || die; - - $files{$file}{ctime} = time(); - - if (!$sth_update->execute($files{$file}{cont},$files{$file}{id})) { - print "update problem: ",$sth_update->errstr; - clear_cont; - return 0; - } else { - if (! $dbh->commit) { - print "ERROR: commit problem: ",$sth_update->errstr; - clear_cont; - return 0; - } - print "updated '$file' [",$files{$file}{id},"]\n"; - } - return 1; -} - -sub e_write { - my $file = filename_fixup(shift); - my ($buf_len,$off) = @_; - - return -ENOENT() unless exists($files{$file}); - - my $len = length($files{$file}{cont}); - - print "write '$file' [$len bytes] offset $off length\n"; - - $files{$file}{cont} = - substr($files{$file}{cont},0,$off) . - $buf_len . - substr($files{$file}{cont},$off+length($buf_len)); - - if (! update_db($file)) { - return -ENOSYS(); - } else { - return length($buf_len); - } -} - -sub e_truncate { - my $file = filename_fixup(shift); - my $size = shift; - - $files{$file}{cont} = substr($files{$file}{cont},0,$size); - return 0 -}; - - -sub e_utime { - my ($atime,$mtime,$file) = @_; - $file = filename_fixup($file); - - return -ENOENT() unless exists($files{$file}); - - print "utime '$file' $atime $mtime\n"; - - $files{$file}{time} = $mtime; - return 0; -} - -sub e_statfs { return 255, 1, 1, 1, 1, 2 } - -# If you run the script directly, it will run fusermount, which will in turn -# re-run this script. Hence the funky semantics. -my ($mountpoint) = ""; -$mountpoint = shift(@ARGV) if @ARGV; -Fuse::main( - mountpoint=>$mountpoint, - getattr=>\&e_getattr, - getdir=>\&e_getdir, - open=>\&e_open, - statfs=>\&e_statfs, - read=>\&e_read, - write=>\&e_write, - utime=>\&e_utime, - truncate=>\&e_truncate, - debug=>0, -); diff --git a/t/01load.t b/t/01load.t new file mode 100755 index 0000000..85e5f18 --- /dev/null +++ b/t/01load.t @@ -0,0 +1,10 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 1; +use blib; + +use_ok('jsFind'); + diff --git a/t/99pod.t b/t/99pod.t new file mode 100755 index 0000000..7f8e143 --- /dev/null +++ b/t/99pod.t @@ -0,0 +1,11 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::Pod tests => 1; + +use jsFind; + +pod_file_ok($INC{"jsFind.pm"}); +