--- IO-AIO/AIO.pm 2007/12/02 21:51:36 1.120 +++ IO-AIO/AIO.pm 2008/09/06 07:14:52 1.133 @@ -28,9 +28,8 @@ my $grp = aio_group sub { print "all stats done\n" }; add $grp aio_stat "..." for ...; - # AnyEvent integration (EV, Event, Glib, Tk, urxvt, pureperl...) - open my $fh, "<&=" . IO::AIO::poll_fileno or die "$!"; - my $w = AnyEvent->io (fh => $fh, poll => 'r', cb => sub { IO::AIO::poll_cb }); + # AnyEvent integration (EV, Event, Glib, Tk, POE, urxvt, pureperl...) + use AnyEvent::AIO; # EV integration my $w = EV::io IO::AIO::poll_fileno, EV::READ, \&IO::AIO::poll_cb; @@ -196,7 +195,7 @@ use base 'Exporter'; BEGIN { - our $VERSION = '2.6'; + our $VERSION = '3.07'; our @AIO_REQ = qw(aio_sendfile aio_read aio_write aio_open aio_close aio_stat aio_lstat aio_unlink aio_rmdir aio_readdir @@ -206,7 +205,7 @@ aio_nop aio_mknod aio_load aio_rmtree aio_mkdir aio_chown aio_chmod aio_utime aio_truncate); - our @EXPORT = (@AIO_REQ, qw(aioreq_pri aioreq_nice aio_block)); + our @EXPORT = (@AIO_REQ, qw(aioreq_pri aioreq_nice)); our @EXPORT_OK = qw(poll_fileno poll_cb poll_wait flush min_parallel max_parallel max_idle nreqs nready npending nthreads @@ -324,66 +323,17 @@ code. Unfortunately, you can't do this to perl. Perl I very strongly on -closing the file descriptor associated with the filehandle itself. Here is -what aio_close will try: +closing the file descriptor associated with the filehandle itself. - 1. dup()licate the fd - 2. asynchronously close() the duplicated fd - 3. dup()licate the fd once more - 4. let perl close() the filehandle - 5. asynchronously close the duplicated fd - -The idea is that the first close() flushes stuff to disk that closing an -fd will flush, so when perl closes the fd, nothing much will need to be -flushed. The second async. close() will then flush stuff to disk that -closing the last fd to the file will flush. - -Just FYI, SuSv3 has this to say on close: - - All outstanding record locks owned by the process on the file - associated with the file descriptor shall be removed. - - If fildes refers to a socket, close() shall cause the socket to be - destroyed. ... close() shall block for up to the current linger - interval until all data is transmitted. - [this actually sounds like a specification bug, but who knows] +Therefore, C will not close the filehandle - instead it will +use dup2 to overwrite the file descriptor with the write-end of a pipe +(the pipe fd will be created on demand and will be cached). -And at least Linux additionally actually flushes stuff on every close, -even when the file itself is still open. - -Sounds enourmously inefficient and complicated? Yes... please show me how -to nuke perl's fd out of existence... +Or in other words: the file descriptor will be closed, but it will not be +free for reuse until the perl filehandle is closed. =cut -sub aio_close($;$) { - aio_block { - my ($fh, $cb) = @_; - - my $pri = aioreq_pri; - my $grp = aio_group $cb; - - my $fd = fileno $fh; - - defined $fd or Carp::croak "aio_close called with fd-less filehandle"; - - # if the dups fail we will simply get EBADF - my $fd2 = _dup $fd; - aioreq_pri $pri; - add $grp _aio_close $fd2, sub { - my $fd2 = _dup $fd; - close $fh; - aioreq_pri $pri; - add $grp _aio_close $fd2, sub { - $grp->result ($_[0]); - }; - }; - - $grp - } -} - - =item aio_read $fh,$offset,$length, $data,$dataoffset, $callback->($retval) =item aio_write $fh,$offset,$length, $data,$dataoffset, $callback->($retval) @@ -591,26 +541,24 @@ =cut sub aio_load($$;$) { - aio_block { - my ($path, undef, $cb) = @_; - my $data = \$_[1]; + my ($path, undef, $cb) = @_; + my $data = \$_[1]; - my $pri = aioreq_pri; - my $grp = aio_group $cb; + my $pri = aioreq_pri; + my $grp = aio_group $cb; - aioreq_pri $pri; - add $grp aio_open $path, O_RDONLY, 0, sub { - my $fh = shift - or return $grp->result (-1); + aioreq_pri $pri; + add $grp aio_open $path, O_RDONLY, 0, sub { + my $fh = shift + or return $grp->result (-1); - aioreq_pri $pri; - add $grp aio_read $fh, 0, (-s $fh), $$data, 0, sub { - $grp->result ($_[0]); - }; + aioreq_pri $pri; + add $grp aio_read $fh, 0, (-s $fh), $$data, 0, sub { + $grp->result ($_[0]); }; + }; - $grp - } + $grp } =item aio_copy $srcpath, $dstpath, $callback->($status) @@ -631,54 +579,52 @@ =cut sub aio_copy($$;$) { - aio_block { - my ($src, $dst, $cb) = @_; + my ($src, $dst, $cb) = @_; - my $pri = aioreq_pri; - my $grp = aio_group $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 $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; - - aioreq_pri $pri; - add $grp aio_close $dst_fh; - } else { - $grp->result (-1); - close $src_fh; - close $dst_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; + + aioreq_pri $pri; + add $grp aio_close $dst_fh; + } else { + $grp->result (-1); + close $src_fh; + close $dst_fh; + + aioreq $pri; + add $grp aio_unlink $dst; + } + }; + } else { + $grp->result (-1); + } + }, - aioreq $pri; - add $grp aio_unlink $dst; - } - }; - } else { - $grp->result (-1); - } - }, - - } else { - $grp->result (-1); - } - }; + } else { + $grp->result (-1); + } + }; - $grp - } + $grp } =item aio_move $srcpath, $dstpath, $callback->($status) @@ -694,31 +640,29 @@ =cut sub aio_move($$;$) { - aio_block { - my ($src, $dst, $cb) = @_; - - my $pri = aioreq_pri; - my $grp = aio_group $cb; + my ($src, $dst, $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]); + my $pri = aioreq_pri; + my $grp = aio_group $cb; - if (!$_[0]) { - aioreq_pri $pri; - add $grp aio_unlink $src; - } - }; - } else { + 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]); - } - }; - $grp - } + if (!$_[0]) { + aioreq_pri $pri; + add $grp aio_unlink $src; + } + }; + } else { + $grp->result ($_[0]); + } + }; + + $grp } =item aio_scandir $path, $maxreq, $callback->($dirs, $nondirs) @@ -776,91 +720,89 @@ =cut sub aio_scandir($$;$) { - aio_block { - my ($path, $maxreq, $cb) = @_; + my ($path, $maxreq, $cb) = @_; - my $pri = aioreq_pri; + my $pri = aioreq_pri; - my $grp = aio_group $cb; + my $grp = aio_group $cb; - $maxreq = 4 if $maxreq <= 0; + $maxreq = 4 if $maxreq <= 0; - # stat once + # stat once + aioreq_pri $pri; + add $grp aio_stat $path, sub { + return $grp->result () if $_[0]; + my $now = time; + my $hash1 = join ":", (stat _)[0,1,3,7,9]; + + # read the directory entries aioreq_pri $pri; - add $grp aio_stat $path, sub { - return $grp->result () if $_[0]; - my $now = time; - my $hash1 = join ":", (stat _)[0,1,3,7,9]; + add $grp aio_readdir $path, sub { + my $entries = shift + or return $grp->result (); - # read the directory entries + # stat the dir another time aioreq_pri $pri; - add $grp aio_readdir $path, sub { - my $entries = shift - or return $grp->result (); + add $grp aio_stat $path, sub { + my $hash2 = join ":", (stat _)[0,1,3,7,9]; - # stat the dir another time - aioreq_pri $pri; - add $grp aio_stat $path, sub { - my $hash2 = join ":", (stat _)[0,1,3,7,9]; + my $ndirs; - my $ndirs; + # take the slow route if anything looks fishy + if ($hash1 ne $hash2 or (stat _)[9] == $now) { + $ndirs = -1; + } else { + # if nlink == 2, we are finished + # on non-posix-fs's, we rely on nlink < 2 + $ndirs = (stat _)[3] - 2 + or return $grp->result ([], $entries); + } + + # sort into likely dirs and likely nondirs + # dirs == files without ".", short entries first + $entries = [map $_->[0], + sort { $b->[1] cmp $a->[1] } + map [$_, sprintf "%s%04d", (/.\./ ? "1" : "0"), length], + @$entries]; - # take the slow route if anything looks fishy - if ($hash1 ne $hash2 or (stat _)[9] == $now) { - $ndirs = -1; - } else { - # if nlink == 2, we are finished - # on non-posix-fs's, we rely on nlink < 2 - $ndirs = (stat _)[3] - 2 - or return $grp->result ([], $entries); - } - - # sort into likely dirs and likely nondirs - # dirs == files without ".", short entries first - $entries = [map $_->[0], - sort { $b->[1] cmp $a->[1] } - map [$_, sprintf "%s%04d", (/.\./ ? "1" : "0"), length], - @$entries]; + my (@dirs, @nondirs); - my (@dirs, @nondirs); + my $statgrp = add $grp aio_group sub { + $grp->result (\@dirs, \@nondirs); + }; - my $statgrp = add $grp aio_group sub { - $grp->result (\@dirs, \@nondirs); - }; + limit $statgrp $maxreq; + feed $statgrp sub { + return unless @$entries; + my $entry = pop @$entries; - limit $statgrp $maxreq; - feed $statgrp sub { - return unless @$entries; - my $entry = pop @$entries; - - aioreq_pri $pri; - add $statgrp aio_stat "$path/$entry/.", sub { - if ($_[0] < 0) { - push @nondirs, $entry; - } else { - # need to check for real directory - aioreq_pri $pri; - add $statgrp aio_lstat "$path/$entry", sub { - if (-d _) { - push @dirs, $entry; - - unless (--$ndirs) { - push @nondirs, @$entries; - feed $statgrp; - } - } else { - push @nondirs, $entry; + aioreq_pri $pri; + add $statgrp aio_stat "$path/$entry/.", sub { + if ($_[0] < 0) { + push @nondirs, $entry; + } else { + # need to check for real directory + aioreq_pri $pri; + add $statgrp aio_lstat "$path/$entry", sub { + if (-d _) { + push @dirs, $entry; + + unless (--$ndirs) { + push @nondirs, @$entries; + feed $statgrp; } + } else { + push @nondirs, $entry; } } - }; + } }; }; }; }; + }; - $grp - } + $grp } =item aio_rmtree $path, $callback->($status) @@ -874,30 +816,28 @@ sub aio_rmtree; sub aio_rmtree($;$) { - aio_block { - my ($path, $cb) = @_; + my ($path, $cb) = @_; - my $pri = aioreq_pri; - my $grp = aio_group $cb; + my $pri = aioreq_pri; + my $grp = aio_group $cb; - aioreq_pri $pri; - add $grp aio_scandir $path, 0, sub { - my ($dirs, $nondirs) = @_; + aioreq_pri $pri; + add $grp aio_scandir $path, 0, sub { + my ($dirs, $nondirs) = @_; - my $dirgrp = aio_group sub { - add $grp aio_rmdir $path, sub { - $grp->result ($_[0]); - }; + my $dirgrp = aio_group sub { + add $grp aio_rmdir $path, sub { + $grp->result ($_[0]); }; + }; - (aioreq_pri $pri), add $dirgrp aio_rmtree "$path/$_" for @$dirs; - (aioreq_pri $pri), add $dirgrp aio_unlink "$path/$_" for @$nondirs; + (aioreq_pri $pri), add $dirgrp aio_rmtree "$path/$_" for @$dirs; + (aioreq_pri $pri), add $dirgrp aio_unlink "$path/$_" for @$nondirs; - add $grp $dirgrp; - }; + add $grp $dirgrp; + }; - $grp - } + $grp } =item aio_sync $callback->($status) @@ -931,30 +871,28 @@ =cut sub aio_pathsync($;$) { - aio_block { - my ($path, $cb) = @_; + my ($path, $cb) = @_; - my $pri = aioreq_pri; - my $grp = aio_group $cb; + my $pri = aioreq_pri; + my $grp = aio_group $cb; - aioreq_pri $pri; - add $grp aio_open $path, O_RDONLY, 0, sub { - my ($fh) = @_; - if ($fh) { - aioreq_pri $pri; - add $grp aio_fsync $fh, sub { - $grp->result ($_[0]); + aioreq_pri $pri; + add $grp aio_open $path, O_RDONLY, 0, sub { + my ($fh) = @_; + if ($fh) { + aioreq_pri $pri; + add $grp aio_fsync $fh, sub { + $grp->result ($_[0]); - aioreq_pri $pri; - add $grp aio_close $fh; - }; - } else { - $grp->result (-1); - } - }; + aioreq_pri $pri; + add $grp aio_close $fh; + }; + } else { + $grp->result (-1); + } + }; - $grp - } + $grp } =item aio_group $callback->(...) @@ -1077,10 +1015,11 @@ C state, they will also finish. Otherwise they will continue to exist. -That means after creating a group you have some time to add requests. And -in the callbacks of those requests, you can add further requests to the -group. And only when all those requests have finished will the the group -itself finish. +That means after creating a group you have some time to add requests +(precisely before the callback has been invoked, which is only done within +the C). And in the callbacks of those requests, you can add +further requests to the group. And only when all those requests have +finished will the the group itself finish. =over 4 @@ -1181,12 +1120,14 @@ =item IO::AIO::poll_cb Process some outstanding events on the result pipe. You have to call this -regularly. Returns the number of events processed. Returns immediately -when no events are outstanding. The amount of events processed depends on -the settings of C and C. +regularly. Returns C<0> if all events could be processed, or C<-1> if it +returned earlier for whatever reason. Returns immediately when no events +are outstanding. The amount of events processed depends on the settings of +C and C. If not all requests were processed for whatever reason, the filehandle -will still be ready when C returns. +will still be ready when C returns, so normally you don't have to +do anything special to have it called later. Example: Install an Event watcher that automatically calls IO::AIO::poll_cb with high priority: @@ -1310,7 +1251,7 @@ creation is fast. If thread creation is very slow on your system you might want to use larger values. -=item $oldmaxreqs = IO::AIO::max_outstanding $maxreqs +=item IO::AIO::max_outstanding $maxreqs This is a very bad function to use in interactive programs because it blocks, and a bad way to reduce concurrency because it is inexact: Better @@ -1325,7 +1266,7 @@ number of outstanding requests. You can still queue as many requests as you want. Therefore, -C is mainly useful in simple scripts (with low values) or +C is mainly useful in simple scripts (with low values) or as a stop gap to shield against fatal memory overflow (with large values). =back @@ -1405,7 +1346,8 @@ =head1 SEE ALSO -L. +L for easy integration into event loops, L for a +more natural syntax. =head1 AUTHOR