sqlfs-perl

 view release on metacpan or  search on metacpan

lib/DBI/Filesystem.pm  view on Meta::CPAN

    return $self->_inode2path($parent)."/".$name;
}

sub _dirname {
    my $self = shift;
    my $path = shift;
    my $dir  = dirname($path);
    $dir     = '/' if $dir eq '.'; # work around funniness in dirname()    
    return $dir;
}

sub _path2inode_sql {
    my $self   = shift;
    my $path   = shift;
    my (undef,$dir,$name) = File::Spec->splitpath($path);
    my ($parent,@base)    = $self->_path2inode_subselect($dir); # something nicely recursive
    my $sql               = <<END;
select p.inode,p.parent,p.name from metadata as m,path as p 
       where p.name=? and p.parent in ($parent) 
         and m.inode=p.inode
END
;
    return ($sql,$name,@base);
}

sub _path2inode_subselect {
    my $self = shift;
    my $path = shift;
    return 'select 1' if $path eq '/' or !length($path);
    $path =~ s!/$!!;
    my (undef,$dir,$name) = File::Spec->splitpath($path);
    my ($parent,@base)    = $self->_path2inode_subselect($dir); # something nicely recursive
    return (<<END,$name,@base);
select p.inode from metadata as m,path as p
    where p.name=? and p.parent in ($parent)
    and m.inode=p.inode
END
;
}

=head2 $groups = $fs->get_groups($uid,$gid)

This method takes a UID and GID, and returns the primary and
supplemental groups to which the user is assigned, and is used during
permission checking. The result is a hashref in which the keys are the
groups to which the user belongs.

=cut

sub get_groups {
    my $self = shift;
    my ($uid,$gid) = @_;
    return $self->{_group_cache}{$uid} ||= $self->_get_groups($uid,$gid);
}

sub _get_groups {
    my $self = shift;
    my ($uid,$gid) = @_;
    my %result;
    $result{$gid}++;
    my $username = getpwuid($uid) or return \%result;
    while (my($name,undef,$id,$members) = getgrent) {
	next unless $members =~ /\b$username\b/;
	$result{$id}++;
    }
    endgrent;
    return \%result;
}

=head2 $ctx = $fs->get_context

This method is a wrapper around the fuse_get_context() function
described in L<Fuse>. If called before the filesystem is mounted, then
it fakes the call, returning a context object based on the information
in the current process.

=cut

sub get_context {
    my $self = shift;
    return fuse_get_context() if $self->mounted;
    my ($gid) = $( =~ /^(\d+)/;
    return {
	uid   => $<,
	gid   => $gid,
	pid   => $$,
	umask => umask()
    }
}

################# a few SQL fragments; most are inline or in the DBD-specific descendents ######
sub _fgetattr_sql {
    my $self  = shift;
    my $inode = shift;
    my $times = join ',',map{$self->_get_unix_timestamp_sql($_)} 'ctime','mtime','atime';
    return <<END;
select inode,mode,uid,gid,rdev,links,
       $times,size
 from metadata
 where inode=$inode
END
}

sub _create_inode_sql {
    my $self = shift;
    my $now = $self->_now_sql;
    return "insert into metadata (mode,uid,gid,rdev,links,mtime,ctime,atime) values(?,?,?,?,?,$now,$now,$now)";
}


1;

=head1 SUBCLASSING

Subclass this module as you ordinarily would by creating a new package
that has a "use base DBI::Filesystem". You can then tell the
command-line sqlfs.pl tool to load your subclass rather than the
original by providing a --module (or -M) option, as in:

 $ sqlfs.pl -MDBI::Filesystem::MyClass <database> <mtpt>



( run in 1.637 second using v1.01-cache-2.11-cpan-df04353d9ac )