--- IO-AIO/AIO.pm 2006/10/27 19:17:23 1.81 +++ IO-AIO/AIO.pm 2006/10/27 20:10:06 1.82 @@ -133,7 +133,7 @@ our @AIO_REQ = 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_rename aio_link aio_move - aio_group aio_nop); + aio_copy aio_group aio_nop aio_mknod); our @EXPORT = (@AIO_REQ, qw(aioreq_pri aioreq_nice)); our @EXPORT_OK = qw(poll_fileno poll_cb poll_wait flush min_parallel max_parallel nreqs nready npending); @@ -267,81 +267,6 @@ print "read $_[0] bytes: <$buffer>\n"; }; -=item aio_move $srcpath, $dstpath, $callback->($status) - -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) = @_; - - my $pri = aioreq_pri; - my $grp = aio_group $cb; - - aioreq_pri $pri; - add $grp aio_rename $src, $dst, sub { - if ($_[0] && $! == EXDEV) { - aioreq_pri $pri; - add $grp aio_open $src, O_RDONLY, 0, sub { - if (my $src_fh = $_[0]) { - my @stat = stat $src_fh; - - aioreq_pri $pri; - add $grp aio_open $dst, O_WRONLY, 0200, sub { - if (my $dst_fh = $_[0]) { - aioreq_pri $pri; - add $grp 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; - - aioreq_pri $pri; - add $grp aio_unlink $src, sub { - $grp->result ($_[0]); - }; - } else { - my $errno = $!; - aioreq_pri $pri; - add $grp aio_unlink $dst, sub { - $! = $errno; - $grp->result (-1); - }; - } - }; - } else { - $grp->result (-1); - } - }, - - } else { - $grp->result (-1); - } - }; - } else { - $grp->result ($_[0]); - } - }; - - $grp -} - =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 @@ -406,6 +331,12 @@ Asynchronously unlink (delete) a file and call the callback with the result code. +=item aio_mknod $path, $mode, $dev, $callback->($status) + +Asynchronously create a device node (or fifo). See mknod(2): the only +portable value for C<$mode> is C ored with permissions, and C<0> +for C<$dev>. + =item aio_link $srcpath, $dstpath, $callback->($status) Asynchronously create a new link to the existing object at C<$srcpath> at @@ -435,6 +366,108 @@ The callback a single argument which is either C or an array-ref with the filenames. +=item aio_copy $srcpath, $dstpath, $callback->($status) + +Try to copy 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 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. + +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_copy($$;$) { + my ($src, $dst, $cb) = @_; + + my $pri = aioreq_pri; + my $grp = aio_group $cb; + + aioreq_pri $pri; + add $grp aio_open $src, O_RDONLY, 0, sub { + if (my $src_fh = $_[0]) { + my @stat = stat $src_fh; + + aioreq_pri $pri; + add $grp aio_open $dst, O_CREAT | O_WRONLY | O_TRUNC, 0200, sub { + if (my $dst_fh = $_[0]) { + aioreq_pri $pri; + add $grp aio_sendfile $dst_fh, $src_fh, 0, $stat[7], sub { + if ($_[0] == $stat[7]) { + $grp->result (0); + close $src_fh; + + # those should not normally block. should. should. + utime $stat[8], $stat[9], $dst; + chmod $stat[2] & 07777, $dst_fh; + chown $stat[4], $stat[5], $dst_fh; + close $dst_fh; + } else { + $grp->result (-1); + close $src_fh; + close $dst_fh; + + aioreq $pri; + add $grp aio_unlink $dst; + } + }; + } else { + $grp->result (-1); + } + }, + + } else { + $grp->result (-1); + } + }; + + $grp +} + +=item aio_move $srcpath, $dstpath, $callback->($status) + +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 copies the file with C and, if +that is successful, unlinking the C<$srcpath>. + +=cut + +sub aio_move($$;$) { + my ($src, $dst, $cb) = @_; + + my $pri = aioreq_pri; + my $grp = aio_group $cb; + + aioreq_pri $pri; + add $grp aio_rename $src, $dst, sub { + if ($_[0] && $! == EXDEV) { + aioreq_pri $pri; + add $grp aio_copy $src, $dst, sub { + $grp->result ($_[0]); + + if (!$_[0]) { + aioreq_pri $pri; + add $grp aio_unlink $src; + } + }; + } else { + $grp->result ($_[0]); + } + }; + + $grp +} + =item aio_scandir $path, $maxreq, $callback->($dirs, $nondirs) Scans a directory (similar to C) but additionally tries to @@ -957,6 +990,10 @@ min_parallel 8; +END { + flush; +}; + 1; =head2 FORK BEHAVIOUR