--- IO-AIO/AIO.pm 2005/08/30 15:45:10 1.40 +++ IO-AIO/AIO.pm 2006/06/24 16:27:02 1.50 @@ -17,6 +17,10 @@ $_[0] > 0 or die "read error: $!"; }; + # AnyEvent + open my $fh, "<&=" . IO::AIO::poll_fileno or die "$!"; + my $w = AnyEvent->io (fh => $fh, poll => 'r', cb => sub { IO::AIO::poll_cb }); + # Event Event->io (fd => IO::AIO::poll_fileno, poll => 'r', @@ -65,11 +69,11 @@ use Fcntl (); BEGIN { - $VERSION = 1.6; + $VERSION = '1.8'; @EXPORT = qw(aio_sendfile aio_read aio_write aio_open aio_close aio_stat aio_lstat aio_unlink aio_rmdir aio_readdir aio_scandir aio_symlink - aio_fsync aio_fdatasync aio_readahead); + aio_fsync aio_fdatasync aio_readahead aio_rename aio_link aio_move); @EXPORT_OK = qw(poll_fileno poll_cb min_parallel max_parallel max_outstanding nreqs); @@ -166,6 +170,71 @@ print "read $_[0] bytes: <$buffer>\n"; }; +=item aio_move $srcpath, $dstpath, $callback->($status) + +[EXPERIMENTAL] + +Try to move the I (directories not supported as either source or destination) +from C<$srcpath> to C<$dstpath> and call the callback with the C<0> (error) or C<-1> ok. + +This is a composite request that tries to rename(2) the file first. If +rename files with C, it creates the destination file with mode 0200 +and copies the contents of the source file into it using C, +followed by restoring atime, mtime, access mode and uid/gid, in that +order, and unlinking the C<$srcpath>. + +If an error occurs, the partial destination file will be unlinked, if +possible, except when setting atime, mtime, access mode and uid/gid, where +errors are being ignored. + +=cut + +sub aio_move($$$) { + my ($src, $dst, $cb) = @_; + + aio_rename $src, $dst, sub { + if ($_[0] && $! == Errno::EXDEV) { + aio_open $src, O_RDONLY, 0, sub { + if (my $src_fh = $_[0]) { + my @stat = stat $src_fh; + + aio_open $dst, O_WRONLY, 0200, sub { + if (my $dst_fh = $_[0]) { + aio_sendfile $dst_fh, $src_fh, 0, $stat[7], sub { + close $src_fh; + + if ($_[0] == $stat[7]) { + utime $stat[8], $stat[9], $dst; + chmod $stat[2] & 07777, $dst_fh; + chown $stat[4], $stat[5], $dst_fh; + close $dst_fh; + + aio_unlink $src, sub { + $cb->($_[0]); + }; + } else { + my $errno = $!; + aio_unlink $dst, sub { + $! = $errno; + $cb->(-1); + }; + } + }; + } else { + $cb->(-1); + } + }, + + } else { + $cb->(-1); + } + }; + } else { + $cb->($_[0]); + } + }; +} + =item aio_sendfile $out_fh, $in_fh, $in_offset, $length, $callback->($retval) Tries to copy C<$length> bytes from C<$in_fh> to C<$out_fh>. It starts @@ -230,12 +299,27 @@ Asynchronously unlink (delete) a file and call the callback with the result code. +=item aio_link $srcpath, $dstpath, $callback->($status) + +Asynchronously create a new link to the existing object at C<$srcpath> at +the path C<$dstpath> and call the callback with the result code. + +=item aio_symlink $srcpath, $dstpath, $callback->($status) + +Asynchronously create a new symbolic link to the existing object at C<$srcpath> at +the path C<$dstpath> and call the callback with the result code. + +=item aio_rename $srcpath, $dstpath, $callback->($status) + +Asynchronously rename the object at C<$srcpath> to C<$dstpath>, just as +rename(2) and call the callback with the result code. + =item aio_rmdir $pathname, $callback->($status) Asynchronously rmdir (delete) a directory and call the callback with the result code. -=item aio_readdir $pathname $callback->($entries) +=item aio_readdir $pathname, $callback->($entries) Unlike the POSIX call of the same name, C reads an entire directory (i.e. opendir + readdir + closedir). The entries will not be @@ -280,7 +364,7 @@ non-initial dot) and likely non-directories (everything else). Then every entry + C will be C'ed, likely directories first. This is often faster because filesystems might detect the type of the entry without -reading the inode data (e.g. ext2s filetype feature). If that succeeds, +reading the inode data (e.g. ext2fs filetype feature). If that succeeds, it assumes that the entry is a directory or a symlink to directory (which will be checked seperately). @@ -296,7 +380,7 @@ # stat once aio_stat $path, sub { - $cb->() if $_[0]; + return $cb->() if $_[0]; my $hash1 = join ":", (stat _)[0,1,3,7,9]; # read the directory entries @@ -317,7 +401,7 @@ # if nlink == 2, we are finished # on non-posix-fs's, we rely on nlink < 2 $ndirs = (stat _)[3] - 2 - or $cb->([], $entries); + or return $cb->([], $entries); } # sort into likely dirs and likely nondirs @@ -343,7 +427,7 @@ # finished undef $statcb; undef $schedcb; - $cb->(\@dirs, \@nondirs); + $cb->(\@dirs, \@nondirs) if $cb; undef $cb; } };