Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Branch: master
Fetching contributors…

Cannot retrieve contributors at this time

422 lines (277 sloc) 8.247 kB
package Filesys::Virtual::Async::Plain;
use strict;
use warnings;
our $VERSION = '0.02';
use Filesys::Virtual::Async;
use base qw( Filesys::Virtual::Async );
#use IO::AIO 2;
use IO::AIO;
sub new {
my $class = shift;
my $self = $class->SUPER::new( @_ );
$self->{aio_max_group} ||= 4;
return $self;
}
sub dirlist {
my ( $self, $path, $withstat, $callback ) = @_;
return $self->readdir( $path, sub {
my $fl = shift;
$fl = [ map { [ $_ ] } @$fl ] if ( ref $fl );
$callback->( $fl );
} ) unless ( $withstat );
$self->readdir( $path, sub {
my $list = shift;
return $callback->() unless ( $list );
my $root = $self->_path_from_root( $path );
my $files = [];
for my $i ( 0 .. $#{$list} ) {
# file path, index
$files->[ $i ] = [ $root.'/'.$list->[ $i ], $i ];
$list->[ $i ] = [ $list->[ $i ] ];
}
my $grp = aio_group( $callback );
# pass $list to the callback
$grp->result( $list );
limit $grp $self->{aio_max_group};
# add files
feed $grp sub {
my $file = pop @$files or return;
add $grp aio_stat $file->[ 0 ], sub {
$_[ 0 ] and return;
$list->[ $file->[ 1 ] ]->[ 1 ] = $_[ 1 ];
};
};
} );
return;
}
sub open {
my $self = shift;
aio_open( $self->_path_from_root( shift ), $_[ 0 ], $_[ 1 ], $_[ 2 ] );
}
sub close {
aio_close( $_[ 1 ], $_[ 2 ] );
}
# don't email me bitching about how this is done. It had to be done this way due to the prototype
# on IO::AIO functions. If you have an alternative, enlighten me.
sub read {
aio_read( $_[ 1 ], $_[ 2 ], $_[ 3 ], $_[ 4 ], $_[ 5 ], $_[ 6 ] );
}
sub write {
aio_write( $_[ 1 ], $_[ 2 ], $_[ 3 ], $_[ 4 ], $_[ 5 ], $_[ 6 ] );
}
sub sendfile {
aio_sendfile( $_[ 1 ], $_[ 2 ], $_[ 3 ], $_[ 4 ], $_[ 5 ] );
}
sub readahead {
aio_readahead( $_[ 1 ], $_[ 2 ], $_[ 3 ], $_[ 4 ] );
}
sub stat {
my ( $self, $file, $callback ) = @_;
# TODO reftype
# TODO stuff _ with stat cache
return aio_stat( $self->_path_from_root( $file ), sub { $callback->( -e _ ? [ (CORE::stat( _ )) ] : undef ); } )
unless ( ref( $file ) eq 'ARRAY' );
# multi-stat
my $list = [];
return $callback->( $list ) unless ( @$file );
my $tostat = [];
foreach my $i ( 0 .. $#{$file} ) {
# file path, index
$tostat->[ $i ] = [ $self->_path_from_root( $file->[ $i ] ), $i ];
$list->[ $i ] = [ $file->[ $i ] ];
}
my $grp = aio_group( $callback );
# pass $list to the callback
$grp->result( $list );
limit $grp $self->{aio_max_group};
# add files
feed $grp sub {
my $f = pop @$tostat or return;
add $grp aio_stat $f->[ 0 ], sub {
$_[ 0 ] and return;
# list[ idx ] = [ path, stat ]
$list->[ $f->[ 1 ] ]->[ 1 ] = [ (CORE::stat( _ )) ];
};
};
return;
}
sub lstat {
my ( $fh, $callback ) = @_;
aio_lstat( $fh, sub { $callback->( [ (CORE::stat( _ )) ] ) } );
}
sub utime {
my $self = shift;
aio_utime( $self->_path_from_root( shift ), $_[ 0 ], $_[ 1 ], $_[ 2 ] );
}
sub chown {
my $self = shift;
aio_chown( $self->_path_from_root( shift ), $_[ 0 ], $_[ 1 ], $_[ 2 ] );
}
sub truncate {
my $self = shift;
aio_truncate( $self->_path_from_root( shift ), $_[ 0 ], $_[ 1 ] );
}
sub chmod {
my $self = shift;
aio_chmod( $self->_path_from_root( shift ), $_[ 0 ], $_[ 1 ] );
}
sub unlink {
my $self = shift;
aio_unlink( $self->_path_from_root( shift ), $_[ 0 ] );
}
sub mknod {
my $self = shift;
aio_mknod( $self->_path_from_root( shift ), $_[ 0 ], $_[ 1 ], $_[ 2 ] );
}
sub link {
my $self = shift;
aio_link( $self->_path_from_root( shift ), $self->_path_from_root( shift ), $_[ 0 ] );
}
sub symlink {
my $self = shift;
aio_symlink( $self->_path_from_root( shift ), $self->_path_from_root( shift ), $_[ 0 ] );
}
sub readlink {
my $self = shift;
aio_readlink( $self->_path_from_root( shift ), $_[ 0 ] );
}
sub rename {
my $self = shift;
aio_rename( $self->_path_from_root( shift ), $self->_path_from_root( shift ), $_[ 0 ] );
}
sub mkdir {
my $self = shift;
aio_mkdir( $self->_path_from_root( shift ), $_[ 0 ], $_[ 1 ] );
}
sub rmdir {
my $self = shift;
aio_rmdir( $self->_path_from_root( shift ), $_[ 0 ] );
}
sub readdir {
my $self = shift;
aio_readdir( $self->_path_from_root( shift ), $_[ 0 ] );
}
sub load {
my $self = shift;
aio_load( $self->_path_from_root( shift ), $_[ 0 ], $_[ 1 ] );
}
sub copy {
my $self = shift;
my $src = $self->_path_from_root( shift );
my $dest = $self->_path_from_root( shift );
# aio won't take an ending slash
$dest =~ s/\/$//;
aio_copy( $src, $dest, $_[ 0 ] );
}
sub move {
my $self = shift;
my $src = $self->_path_from_root( shift );
my $dest = $self->_path_from_root( shift );
# aio won't take an ending slash
$dest =~ s/\/$//;
aio_move( $src, $dest, $_[ 0 ] );
}
sub scandir {
my $self = shift;
aio_scandir( $self->_path_from_root( shift ), $_[ 0 ], $_[ 1 ] );
}
sub rmtree {
my $self = shift;
aio_rmtree( $self->_path_from_root( shift ), $_[ 0 ] );
}
sub fsync {
aio_fsync( $_[ 1 ], $_[ 2 ] );
}
sub fdatasync {
aio_fdatasync( $_[ 1 ], $_[ 2 ] );
}
1;
__END__
=pod
=head1 NAME
Filesys::Virtual::Async::Plain - A plain non-blocking virtual filesystem
=head1 SYNOPSIS
use Filesys::Virtual::Async::Plain;
my $fs = Filesys::Virtual::Async::Plain->new(
root => '/home/foo',
);
$fs->mkdir( '/bar', $mode, sub {
if ( $_[0] ) {
print "success\n";
} else {
print "failure:$!\n";
}
});
=head1 DESCRIPTION
Filesys::Virtual::Async::Plain provides non-blocking access to virtual
filesystem rooted in a real filesystem. It's like a chrooted filesytem
=head1 WARNING
This module is still in flux to an extent. It will change. I released this
module early due to demand. If you'd like to suggest changes, please drop in
the irc channel #poe on irc.perl.org and speak with xantus[] or Apocalypse
=head1 OBJECT METHODS
=over 4
=item new( root => $path );
root is optional, and defaults to /. root is prepended to all paths after
resolution
=item cwd()
Returns the current working directory (virtual)
=item root() or root( $path )
Gets or sets the root path
=back
=head1 CALLBACK METHODS
All of these work exactly like the L<IO::AIO> methods of the same name. Use
L<IO::AIO> as a reference for these functions. This module is mostly a wrapper
around L<IO::AIO>. All paths passed to these functions are resolved for you, so
pass virtual paths, not the full path on disk as you would pass to aio
=over 4
=item dirlist( $path, $withstat, $callback )
Not an aio method, but a helper that will fetch a list of files in a path, and
optionally stat each file. The callback is called with an array. The first
element is the file name and the second param is an array ref of the return value
of io_stat() if requested.
=item open()
=item close()
=item read()
=item write()
=item sendfile()
=item readahead()
=item stat()
=item lstat()
=item utime()
=item chown()
=item truncate()
=item chmod()
=item unlink()
=item mknod()
=item link()
=item symlink()
=item readlink()
=item rename()
=item mkdir()
=item rmdir()
=item readdir()
=item load()
=item copy()
=item move()
=item scandir()
=item rmtree()
=item fsync()
=item fdatasync()
=back
=head1 SEE ALSO
L<Filesys::Virtual::Async>
L<http://xant.us/>
=head1 BUGS
Probably. Report 'em:
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Filesys-Virtual-Async-Plain>
=head1 AUTHOR
David W Davis E<lt>xantus@cpan.orgE<gt>
=head1 RATING
You can rate this this module at
L<http://cpanratings.perl.org/rate/?distribution=Filesys::Virtual::Async::Plain>
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2009 by David W Davis, All rights reserved
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself
=cut
Jump to Line
Something went wrong with that request. Please try again.