ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/IO-AIO/AIO.pm
(Generate patch)

Comparing IO-AIO/AIO.pm (file contents):
Revision 1.105 by root, Sun Mar 25 00:20:27 2007 UTC vs.
Revision 1.124 by root, Sat May 10 19:25:33 2008 UTC

26 $req->cancel; # cancel request if still in queue 26 $req->cancel; # cancel request if still in queue
27 27
28 my $grp = aio_group sub { print "all stats done\n" }; 28 my $grp = aio_group sub { print "all stats done\n" };
29 add $grp aio_stat "..." for ...; 29 add $grp aio_stat "..." for ...;
30 30
31 # AnyEvent integration 31 # AnyEvent integration (EV, Event, Glib, Tk, urxvt, pureperl...)
32 open my $fh, "<&=" . IO::AIO::poll_fileno or die "$!"; 32 open my $fh, "<&=" . IO::AIO::poll_fileno or die "$!";
33 my $w = AnyEvent->io (fh => $fh, poll => 'r', cb => sub { IO::AIO::poll_cb }); 33 my $w = AnyEvent->io (fh => $fh, poll => 'r', cb => sub { IO::AIO::poll_cb });
34
35 # EV integration
36 my $w = EV::io IO::AIO::poll_fileno, EV::READ, \&IO::AIO::poll_cb;
34 37
35 # Event integration 38 # Event integration
36 Event->io (fd => IO::AIO::poll_fileno, 39 Event->io (fd => IO::AIO::poll_fileno,
37 poll => 'r', 40 poll => 'r',
38 cb => \&IO::AIO::poll_cb); 41 cb => \&IO::AIO::poll_cb);
62etc.), but can also be used to easily do operations in parallel that are 65etc.), but can also be used to easily do operations in parallel that are
63normally done sequentially, e.g. stat'ing many files, which is much faster 66normally done sequentially, e.g. stat'ing many files, which is much faster
64on a RAID volume or over NFS when you do a number of stat operations 67on a RAID volume or over NFS when you do a number of stat operations
65concurrently. 68concurrently.
66 69
67While most of this works on all types of file descriptors (for example 70While most of this works on all types of file descriptors (for
68sockets), using these functions on file descriptors that support 71example sockets), using these functions on file descriptors that
69nonblocking operation (again, sockets, pipes etc.) is very inefficient or 72support nonblocking operation (again, sockets, pipes etc.) is very
70might not work (aio_read fails on sockets/pipes/fifos). Use an event loop 73inefficient. Use an event loop for that (such as the L<Event|Event>
71for that (such as the L<Event|Event> module): IO::AIO will naturally fit 74module): IO::AIO will naturally fit into such an event loop itself.
72into such an event loop itself.
73 75
74In this version, a number of threads are started that execute your 76In this version, a number of threads are started that execute your
75requests and signal their completion. You don't need thread support 77requests and signal their completion. You don't need thread support
76in perl, and the threads created by this module will not be visible 78in perl, and the threads created by this module will not be visible
77to perl. In the future, this module might make use of the native aio 79to perl. In the future, this module might make use of the native aio
79not well-supported or restricted (GNU/Linux doesn't allow them on normal 81not well-supported or restricted (GNU/Linux doesn't allow them on normal
80files currently, for example), and they would only support aio_read and 82files currently, for example), and they would only support aio_read and
81aio_write, so the remaining functionality would have to be implemented 83aio_write, so the remaining functionality would have to be implemented
82using threads anyway. 84using threads anyway.
83 85
84Although the module will work with in the presence of other (Perl-) 86Although the module will work in the presence of other (Perl-) threads,
85threads, it is currently not reentrant in any way, so use appropriate 87it is currently not reentrant in any way, so use appropriate locking
86locking yourself, always call C<poll_cb> from within the same thread, or 88yourself, always call C<poll_cb> from within the same thread, or never
87never call C<poll_cb> (or other C<aio_> functions) recursively. 89call C<poll_cb> (or other C<aio_> functions) recursively.
88 90
89=head2 EXAMPLE 91=head2 EXAMPLE
90 92
91This is a simple example that uses the Event module and loads 93This is a simple example that uses the Event module and loads
92F</etc/passwd> asynchronously: 94F</etc/passwd> asynchronously:
184 186
185=cut 187=cut
186 188
187package IO::AIO; 189package IO::AIO;
188 190
191use Carp ();
192
189no warnings; 193no warnings;
190use strict 'vars'; 194use strict 'vars';
191 195
192use base 'Exporter'; 196use base 'Exporter';
193 197
194BEGIN { 198BEGIN {
195 our $VERSION = '2.33'; 199 our $VERSION = '3.0';
196 200
197 our @AIO_REQ = qw(aio_sendfile aio_read aio_write aio_open aio_close aio_stat 201 our @AIO_REQ = qw(aio_sendfile aio_read aio_write aio_open aio_close
198 aio_lstat aio_unlink aio_rmdir aio_readdir aio_scandir aio_symlink 202 aio_stat aio_lstat aio_unlink aio_rmdir aio_readdir
199 aio_readlink aio_fsync aio_fdatasync aio_readahead aio_rename aio_link 203 aio_scandir aio_symlink aio_readlink aio_sync aio_fsync
204 aio_fdatasync aio_pathsync aio_readahead
205 aio_rename aio_link aio_move aio_copy aio_group
200 aio_move aio_copy aio_group aio_nop aio_mknod aio_load aio_rmtree aio_mkdir); 206 aio_nop aio_mknod aio_load aio_rmtree aio_mkdir aio_chown
207 aio_chmod aio_utime aio_truncate);
208
201 our @EXPORT = (@AIO_REQ, qw(aioreq_pri aioreq_nice aio_block)); 209 our @EXPORT = (@AIO_REQ, qw(aioreq_pri aioreq_nice));
202 our @EXPORT_OK = qw(poll_fileno poll_cb poll_wait flush 210 our @EXPORT_OK = qw(poll_fileno poll_cb poll_wait flush
203 min_parallel max_parallel max_idle 211 min_parallel max_parallel max_idle
204 nreqs nready npending nthreads 212 nreqs nready npending nthreads
205 max_poll_time max_poll_reqs); 213 max_poll_time max_poll_reqs);
206 214
271 aio_read $_[0], ..., sub { 279 aio_read $_[0], ..., sub {
272 ... 280 ...
273 }; 281 };
274 }; 282 };
275 283
284
276=item aioreq_nice $pri_adjust 285=item aioreq_nice $pri_adjust
277 286
278Similar to C<aioreq_pri>, but subtracts the given value from the current 287Similar to C<aioreq_pri>, but subtracts the given value from the current
279priority, so the effect is cumulative. 288priority, so the effect is cumulative.
289
280 290
281=item aio_open $pathname, $flags, $mode, $callback->($fh) 291=item aio_open $pathname, $flags, $mode, $callback->($fh)
282 292
283Asynchronously open or create a file and call the callback with a newly 293Asynchronously open or create a file and call the callback with a newly
284created filehandle for the file. 294created filehandle for the file.
305 } else { 315 } else {
306 die "open failed: $!\n"; 316 die "open failed: $!\n";
307 } 317 }
308 }; 318 };
309 319
320
310=item aio_close $fh, $callback->($status) 321=item aio_close $fh, $callback->($status)
311 322
312Asynchronously close a file and call the callback with the result 323Asynchronously close a file and call the callback with the result
313code. I<WARNING:> although accepted, you should not pass in a perl 324code.
314filehandle here, as perl will likely close the file descriptor another
315time when the filehandle is destroyed. Normally, you can safely call perls
316C<close> or just let filehandles go out of scope.
317 325
318This is supposed to be a bug in the API, so that might change. It's 326Unfortunately, you can't do this to perl. Perl I<insists> very strongly on
319therefore best to avoid this function. 327closing the file descriptor associated with the filehandle itself.
328
329Therefore, C<aio_close> will not close the filehandle - instead it will
330use dup2 to overwrite the file descriptor with the write-end of a pipe
331(the pipe fd will be created on demand and will be cached).
332
333Or in other words: the file descriptor will be closed, but it will not be
334free for reuse until the perl filehandle is closed.
335
336=cut
320 337
321=item aio_read $fh,$offset,$length, $data,$dataoffset, $callback->($retval) 338=item aio_read $fh,$offset,$length, $data,$dataoffset, $callback->($retval)
322 339
323=item aio_write $fh,$offset,$length, $data,$dataoffset, $callback->($retval) 340=item aio_write $fh,$offset,$length, $data,$dataoffset, $callback->($retval)
324 341
325Reads or writes C<length> bytes from the specified C<fh> and C<offset> 342Reads or writes C<$length> bytes from the specified C<$fh> and C<$offset>
326into the scalar given by C<data> and offset C<dataoffset> and calls the 343into the scalar given by C<$data> and offset C<$dataoffset> and calls the
327callback without the actual number of bytes read (or -1 on error, just 344callback without the actual number of bytes read (or -1 on error, just
328like the syscall). 345like the syscall).
329 346
347If C<$offset> is undefined, then the current file descriptor offset will
348be used (and updated), otherwise the file descriptor offset will not be
349changed by these calls.
350
351If C<$length> is undefined in C<aio_write>, use the remaining length of C<$data>.
352
353If C<$dataoffset> is less than zero, it will be counted from the end of
354C<$data>.
355
330The C<$data> scalar I<MUST NOT> be modified in any way while the request 356The C<$data> scalar I<MUST NOT> be modified in any way while the request
331is outstanding. Modifying it can result in segfaults or WW3 (if the 357is outstanding. Modifying it can result in segfaults or World War III (if
332necessary/optional hardware is installed). 358the necessary/optional hardware is installed).
333 359
334Example: Read 15 bytes at offset 7 into scalar C<$buffer>, starting at 360Example: Read 15 bytes at offset 7 into scalar C<$buffer>, starting at
335offset C<0> within the scalar: 361offset C<0> within the scalar:
336 362
337 aio_read $fh, 7, 15, $buffer, 0, sub { 363 aio_read $fh, 7, 15, $buffer, 0, sub {
338 $_[0] > 0 or die "read error: $!"; 364 $_[0] > 0 or die "read error: $!";
339 print "read $_[0] bytes: <$buffer>\n"; 365 print "read $_[0] bytes: <$buffer>\n";
340 }; 366 };
367
341 368
342=item aio_sendfile $out_fh, $in_fh, $in_offset, $length, $callback->($retval) 369=item aio_sendfile $out_fh, $in_fh, $in_offset, $length, $callback->($retval)
343 370
344Tries to copy C<$length> bytes from C<$in_fh> to C<$out_fh>. It starts 371Tries to copy C<$length> bytes from C<$in_fh> to C<$out_fh>. It starts
345reading at byte offset C<$in_offset>, and starts writing at the current 372reading at byte offset C<$in_offset>, and starts writing at the current
359C<$in_fh> than are written, and there is no way to find out how many 386C<$in_fh> than are written, and there is no way to find out how many
360bytes have been read from C<aio_sendfile> alone, as C<aio_sendfile> only 387bytes have been read from C<aio_sendfile> alone, as C<aio_sendfile> only
361provides the number of bytes written to C<$out_fh>. Only if the result 388provides the number of bytes written to C<$out_fh>. Only if the result
362value equals C<$length> one can assume that C<$length> bytes have been 389value equals C<$length> one can assume that C<$length> bytes have been
363read. 390read.
391
364 392
365=item aio_readahead $fh,$offset,$length, $callback->($retval) 393=item aio_readahead $fh,$offset,$length, $callback->($retval)
366 394
367C<aio_readahead> populates the page cache with data from a file so that 395C<aio_readahead> populates the page cache with data from a file so that
368subsequent reads from that file will not block on disk I/O. The C<$offset> 396subsequent reads from that file will not block on disk I/O. The C<$offset>
374file. The current file offset of the file is left unchanged. 402file. The current file offset of the file is left unchanged.
375 403
376If that syscall doesn't exist (likely if your OS isn't Linux) it will be 404If that syscall doesn't exist (likely if your OS isn't Linux) it will be
377emulated by simply reading the data, which would have a similar effect. 405emulated by simply reading the data, which would have a similar effect.
378 406
407
379=item aio_stat $fh_or_path, $callback->($status) 408=item aio_stat $fh_or_path, $callback->($status)
380 409
381=item aio_lstat $fh, $callback->($status) 410=item aio_lstat $fh, $callback->($status)
382 411
383Works like perl's C<stat> or C<lstat> in void context. The callback will 412Works like perl's C<stat> or C<lstat> in void context. The callback will
396 aio_stat "/etc/passwd", sub { 425 aio_stat "/etc/passwd", sub {
397 $_[0] and die "stat failed: $!"; 426 $_[0] and die "stat failed: $!";
398 print "size is ", -s _, "\n"; 427 print "size is ", -s _, "\n";
399 }; 428 };
400 429
430
431=item aio_utime $fh_or_path, $atime, $mtime, $callback->($status)
432
433Works like perl's C<utime> function (including the special case of $atime
434and $mtime being undef). Fractional times are supported if the underlying
435syscalls support them.
436
437When called with a pathname, uses utimes(2) if available, otherwise
438utime(2). If called on a file descriptor, uses futimes(2) if available,
439otherwise returns ENOSYS, so this is not portable.
440
441Examples:
442
443 # set atime and mtime to current time (basically touch(1)):
444 aio_utime "path", undef, undef;
445 # set atime to current time and mtime to beginning of the epoch:
446 aio_utime "path", time, undef; # undef==0
447
448
449=item aio_chown $fh_or_path, $uid, $gid, $callback->($status)
450
451Works like perl's C<chown> function, except that C<undef> for either $uid
452or $gid is being interpreted as "do not change" (but -1 can also be used).
453
454Examples:
455
456 # same as "chown root path" in the shell:
457 aio_chown "path", 0, -1;
458 # same as above:
459 aio_chown "path", 0, undef;
460
461
462=item aio_truncate $fh_or_path, $offset, $callback->($status)
463
464Works like truncate(2) or ftruncate(2).
465
466
467=item aio_chmod $fh_or_path, $mode, $callback->($status)
468
469Works like perl's C<chmod> function.
470
471
401=item aio_unlink $pathname, $callback->($status) 472=item aio_unlink $pathname, $callback->($status)
402 473
403Asynchronously unlink (delete) a file and call the callback with the 474Asynchronously unlink (delete) a file and call the callback with the
404result code. 475result code.
405 476
477
406=item aio_mknod $path, $mode, $dev, $callback->($status) 478=item aio_mknod $path, $mode, $dev, $callback->($status)
407 479
408[EXPERIMENTAL] 480[EXPERIMENTAL]
409 481
410Asynchronously create a device node (or fifo). See mknod(2). 482Asynchronously create a device node (or fifo). See mknod(2).
411 483
412The only (POSIX-) portable way of calling this function is: 484The only (POSIX-) portable way of calling this function is:
413 485
414 aio_mknod $path, IO::AIO::S_IFIFO | $mode, 0, sub { ... 486 aio_mknod $path, IO::AIO::S_IFIFO | $mode, 0, sub { ...
487
415 488
416=item aio_link $srcpath, $dstpath, $callback->($status) 489=item aio_link $srcpath, $dstpath, $callback->($status)
417 490
418Asynchronously create a new link to the existing object at C<$srcpath> at 491Asynchronously create a new link to the existing object at C<$srcpath> at
419the path C<$dstpath> and call the callback with the result code. 492the path C<$dstpath> and call the callback with the result code.
420 493
494
421=item aio_symlink $srcpath, $dstpath, $callback->($status) 495=item aio_symlink $srcpath, $dstpath, $callback->($status)
422 496
423Asynchronously create a new symbolic link to the existing object at C<$srcpath> at 497Asynchronously create a new symbolic link to the existing object at C<$srcpath> at
424the path C<$dstpath> and call the callback with the result code. 498the path C<$dstpath> and call the callback with the result code.
499
425 500
426=item aio_readlink $path, $callback->($link) 501=item aio_readlink $path, $callback->($link)
427 502
428Asynchronously read the symlink specified by C<$path> and pass it to 503Asynchronously read the symlink specified by C<$path> and pass it to
429the callback. If an error occurs, nothing or undef gets passed to the 504the callback. If an error occurs, nothing or undef gets passed to the
430callback. 505callback.
431 506
507
432=item aio_rename $srcpath, $dstpath, $callback->($status) 508=item aio_rename $srcpath, $dstpath, $callback->($status)
433 509
434Asynchronously rename the object at C<$srcpath> to C<$dstpath>, just as 510Asynchronously rename the object at C<$srcpath> to C<$dstpath>, just as
435rename(2) and call the callback with the result code. 511rename(2) and call the callback with the result code.
512
436 513
437=item aio_mkdir $pathname, $mode, $callback->($status) 514=item aio_mkdir $pathname, $mode, $callback->($status)
438 515
439Asynchronously mkdir (create) a directory and call the callback with 516Asynchronously mkdir (create) a directory and call the callback with
440the result code. C<$mode> will be modified by the umask at the time the 517the result code. C<$mode> will be modified by the umask at the time the
441request is executed, so do not change your umask. 518request is executed, so do not change your umask.
442 519
520
443=item aio_rmdir $pathname, $callback->($status) 521=item aio_rmdir $pathname, $callback->($status)
444 522
445Asynchronously rmdir (delete) a directory and call the callback with the 523Asynchronously rmdir (delete) a directory and call the callback with the
446result code. 524result code.
525
447 526
448=item aio_readdir $pathname, $callback->($entries) 527=item aio_readdir $pathname, $callback->($entries)
449 528
450Unlike the POSIX call of the same name, C<aio_readdir> reads an entire 529Unlike the POSIX call of the same name, C<aio_readdir> reads an entire
451directory (i.e. opendir + readdir + closedir). The entries will not be 530directory (i.e. opendir + readdir + closedir). The entries will not be
452sorted, and will B<NOT> include the C<.> and C<..> entries. 531sorted, and will B<NOT> include the C<.> and C<..> entries.
453 532
454The callback a single argument which is either C<undef> or an array-ref 533The callback a single argument which is either C<undef> or an array-ref
455with the filenames. 534with the filenames.
456 535
536
457=item aio_load $path, $data, $callback->($status) 537=item aio_load $path, $data, $callback->($status)
458 538
459This is a composite request that tries to fully load the given file into 539This is a composite request that tries to fully load the given file into
460memory. Status is the same as with aio_read. 540memory. Status is the same as with aio_read.
461 541
462=cut 542=cut
463 543
464sub aio_load($$;$) { 544sub aio_load($$;$) {
465 aio_block {
466 my ($path, undef, $cb) = @_; 545 my ($path, undef, $cb) = @_;
467 my $data = \$_[1]; 546 my $data = \$_[1];
468 547
469 my $pri = aioreq_pri; 548 my $pri = aioreq_pri;
470 my $grp = aio_group $cb; 549 my $grp = aio_group $cb;
550
551 aioreq_pri $pri;
552 add $grp aio_open $path, O_RDONLY, 0, sub {
553 my $fh = shift
554 or return $grp->result (-1);
471 555
472 aioreq_pri $pri; 556 aioreq_pri $pri;
473 add $grp aio_open $path, O_RDONLY, 0, sub {
474 my $fh = shift
475 or return $grp->result (-1);
476
477 aioreq_pri $pri;
478 add $grp aio_read $fh, 0, (-s $fh), $$data, 0, sub { 557 add $grp aio_read $fh, 0, (-s $fh), $$data, 0, sub {
479 $grp->result ($_[0]); 558 $grp->result ($_[0]);
480 };
481 }; 559 };
482
483 $grp
484 } 560 };
561
562 $grp
485} 563}
486 564
487=item aio_copy $srcpath, $dstpath, $callback->($status) 565=item aio_copy $srcpath, $dstpath, $callback->($status)
488 566
489Try to copy the I<file> (directories not supported as either source or 567Try to copy the I<file> (directories not supported as either source or
500errors are being ignored. 578errors are being ignored.
501 579
502=cut 580=cut
503 581
504sub aio_copy($$;$) { 582sub aio_copy($$;$) {
505 aio_block {
506 my ($src, $dst, $cb) = @_; 583 my ($src, $dst, $cb) = @_;
507 584
508 my $pri = aioreq_pri; 585 my $pri = aioreq_pri;
509 my $grp = aio_group $cb; 586 my $grp = aio_group $cb;
510 587
511 aioreq_pri $pri; 588 aioreq_pri $pri;
512 add $grp aio_open $src, O_RDONLY, 0, sub { 589 add $grp aio_open $src, O_RDONLY, 0, sub {
513 if (my $src_fh = $_[0]) { 590 if (my $src_fh = $_[0]) {
514 my @stat = stat $src_fh; 591 my @stat = stat $src_fh;
515 592
516 aioreq_pri $pri; 593 aioreq_pri $pri;
517 add $grp aio_open $dst, O_CREAT | O_WRONLY | O_TRUNC, 0200, sub { 594 add $grp aio_open $dst, O_CREAT | O_WRONLY | O_TRUNC, 0200, sub {
518 if (my $dst_fh = $_[0]) { 595 if (my $dst_fh = $_[0]) {
519 aioreq_pri $pri; 596 aioreq_pri $pri;
520 add $grp aio_sendfile $dst_fh, $src_fh, 0, $stat[7], sub { 597 add $grp aio_sendfile $dst_fh, $src_fh, 0, $stat[7], sub {
521 if ($_[0] == $stat[7]) { 598 if ($_[0] == $stat[7]) {
522 $grp->result (0); 599 $grp->result (0);
523 close $src_fh; 600 close $src_fh;
524 601
525 # those should not normally block. should. should. 602 # those should not normally block. should. should.
526 utime $stat[8], $stat[9], $dst; 603 utime $stat[8], $stat[9], $dst;
527 chmod $stat[2] & 07777, $dst_fh; 604 chmod $stat[2] & 07777, $dst_fh;
528 chown $stat[4], $stat[5], $dst_fh; 605 chown $stat[4], $stat[5], $dst_fh;
606
607 aioreq_pri $pri;
529 close $dst_fh; 608 add $grp aio_close $dst_fh;
530 } else { 609 } else {
531 $grp->result (-1); 610 $grp->result (-1);
532 close $src_fh; 611 close $src_fh;
533 close $dst_fh; 612 close $dst_fh;
534 613
535 aioreq $pri; 614 aioreq $pri;
536 add $grp aio_unlink $dst; 615 add $grp aio_unlink $dst;
537 }
538 }; 616 }
539 } else {
540 $grp->result (-1);
541 } 617 };
618 } else {
619 $grp->result (-1);
542 }, 620 }
543
544 } else {
545 $grp->result (-1);
546 } 621 },
622
623 } else {
624 $grp->result (-1);
547 }; 625 }
548
549 $grp
550 } 626 };
627
628 $grp
551} 629}
552 630
553=item aio_move $srcpath, $dstpath, $callback->($status) 631=item aio_move $srcpath, $dstpath, $callback->($status)
554 632
555Try to move the I<file> (directories not supported as either source or 633Try to move the I<file> (directories not supported as either source or
561that is successful, unlinking the C<$srcpath>. 639that is successful, unlinking the C<$srcpath>.
562 640
563=cut 641=cut
564 642
565sub aio_move($$;$) { 643sub aio_move($$;$) {
566 aio_block {
567 my ($src, $dst, $cb) = @_; 644 my ($src, $dst, $cb) = @_;
568 645
569 my $pri = aioreq_pri; 646 my $pri = aioreq_pri;
570 my $grp = aio_group $cb; 647 my $grp = aio_group $cb;
571 648
572 aioreq_pri $pri; 649 aioreq_pri $pri;
573 add $grp aio_rename $src, $dst, sub { 650 add $grp aio_rename $src, $dst, sub {
574 if ($_[0] && $! == EXDEV) { 651 if ($_[0] && $! == EXDEV) {
575 aioreq_pri $pri; 652 aioreq_pri $pri;
576 add $grp aio_copy $src, $dst, sub { 653 add $grp aio_copy $src, $dst, sub {
577 $grp->result ($_[0]);
578
579 if (!$_[0]) {
580 aioreq_pri $pri;
581 add $grp aio_unlink $src;
582 }
583 };
584 } else {
585 $grp->result ($_[0]); 654 $grp->result ($_[0]);
655
656 if (!$_[0]) {
657 aioreq_pri $pri;
658 add $grp aio_unlink $src;
659 }
586 } 660 };
661 } else {
662 $grp->result ($_[0]);
587 }; 663 }
588
589 $grp
590 } 664 };
665
666 $grp
591} 667}
592 668
593=item aio_scandir $path, $maxreq, $callback->($dirs, $nondirs) 669=item aio_scandir $path, $maxreq, $callback->($dirs, $nondirs)
594 670
595Scans a directory (similar to C<aio_readdir>) but additionally tries to 671Scans a directory (similar to C<aio_readdir>) but additionally tries to
643directory counting heuristic. 719directory counting heuristic.
644 720
645=cut 721=cut
646 722
647sub aio_scandir($$;$) { 723sub aio_scandir($$;$) {
648 aio_block {
649 my ($path, $maxreq, $cb) = @_; 724 my ($path, $maxreq, $cb) = @_;
650 725
651 my $pri = aioreq_pri; 726 my $pri = aioreq_pri;
652 727
653 my $grp = aio_group $cb; 728 my $grp = aio_group $cb;
654 729
655 $maxreq = 4 if $maxreq <= 0; 730 $maxreq = 4 if $maxreq <= 0;
656 731
657 # stat once 732 # stat once
733 aioreq_pri $pri;
734 add $grp aio_stat $path, sub {
735 return $grp->result () if $_[0];
736 my $now = time;
737 my $hash1 = join ":", (stat _)[0,1,3,7,9];
738
739 # read the directory entries
658 aioreq_pri $pri; 740 aioreq_pri $pri;
659 add $grp aio_stat $path, sub { 741 add $grp aio_readdir $path, sub {
742 my $entries = shift
660 return $grp->result () if $_[0]; 743 or return $grp->result ();
661 my $now = time;
662 my $hash1 = join ":", (stat _)[0,1,3,7,9];
663 744
664 # read the directory entries 745 # stat the dir another time
665 aioreq_pri $pri; 746 aioreq_pri $pri;
666 add $grp aio_readdir $path, sub {
667 my $entries = shift
668 or return $grp->result ();
669
670 # stat the dir another time
671 aioreq_pri $pri;
672 add $grp aio_stat $path, sub { 747 add $grp aio_stat $path, sub {
673 my $hash2 = join ":", (stat _)[0,1,3,7,9]; 748 my $hash2 = join ":", (stat _)[0,1,3,7,9];
674 749
675 my $ndirs; 750 my $ndirs;
676 751
677 # take the slow route if anything looks fishy 752 # take the slow route if anything looks fishy
678 if ($hash1 ne $hash2 or (stat _)[9] == $now) { 753 if ($hash1 ne $hash2 or (stat _)[9] == $now) {
679 $ndirs = -1; 754 $ndirs = -1;
680 } else { 755 } else {
681 # if nlink == 2, we are finished 756 # if nlink == 2, we are finished
682 # on non-posix-fs's, we rely on nlink < 2 757 # on non-posix-fs's, we rely on nlink < 2
683 $ndirs = (stat _)[3] - 2 758 $ndirs = (stat _)[3] - 2
684 or return $grp->result ([], $entries); 759 or return $grp->result ([], $entries);
685 } 760 }
686 761
687 # sort into likely dirs and likely nondirs 762 # sort into likely dirs and likely nondirs
688 # dirs == files without ".", short entries first 763 # dirs == files without ".", short entries first
689 $entries = [map $_->[0], 764 $entries = [map $_->[0],
690 sort { $b->[1] cmp $a->[1] } 765 sort { $b->[1] cmp $a->[1] }
691 map [$_, sprintf "%s%04d", (/.\./ ? "1" : "0"), length], 766 map [$_, sprintf "%s%04d", (/.\./ ? "1" : "0"), length],
692 @$entries]; 767 @$entries];
693 768
694 my (@dirs, @nondirs); 769 my (@dirs, @nondirs);
695 770
696 my $statgrp = add $grp aio_group sub { 771 my $statgrp = add $grp aio_group sub {
697 $grp->result (\@dirs, \@nondirs); 772 $grp->result (\@dirs, \@nondirs);
698 }; 773 };
699 774
700 limit $statgrp $maxreq; 775 limit $statgrp $maxreq;
701 feed $statgrp sub { 776 feed $statgrp sub {
702 return unless @$entries; 777 return unless @$entries;
703 my $entry = pop @$entries; 778 my $entry = pop @$entries;
704 779
705 aioreq_pri $pri; 780 aioreq_pri $pri;
706 add $statgrp aio_stat "$path/$entry/.", sub { 781 add $statgrp aio_stat "$path/$entry/.", sub {
707 if ($_[0] < 0) { 782 if ($_[0] < 0) {
708 push @nondirs, $entry; 783 push @nondirs, $entry;
709 } else { 784 } else {
710 # need to check for real directory 785 # need to check for real directory
711 aioreq_pri $pri; 786 aioreq_pri $pri;
712 add $statgrp aio_lstat "$path/$entry", sub { 787 add $statgrp aio_lstat "$path/$entry", sub {
713 if (-d _) { 788 if (-d _) {
714 push @dirs, $entry; 789 push @dirs, $entry;
715 790
716 unless (--$ndirs) { 791 unless (--$ndirs) {
717 push @nondirs, @$entries; 792 push @nondirs, @$entries;
718 feed $statgrp; 793 feed $statgrp;
719 }
720 } else {
721 push @nondirs, $entry;
722 } 794 }
795 } else {
796 push @nondirs, $entry;
723 } 797 }
724 } 798 }
725 }; 799 }
726 }; 800 };
727 }; 801 };
728 }; 802 };
729 }; 803 };
730
731 $grp
732 } 804 };
805
806 $grp
733} 807}
734 808
735=item aio_rmtree $path, $callback->($status) 809=item aio_rmtree $path, $callback->($status)
736 810
737Delete a directory tree starting (and including) C<$path>, return the 811Delete a directory tree starting (and including) C<$path>, return the
741 815
742=cut 816=cut
743 817
744sub aio_rmtree; 818sub aio_rmtree;
745sub aio_rmtree($;$) { 819sub aio_rmtree($;$) {
746 aio_block {
747 my ($path, $cb) = @_; 820 my ($path, $cb) = @_;
748 821
749 my $pri = aioreq_pri; 822 my $pri = aioreq_pri;
750 my $grp = aio_group $cb; 823 my $grp = aio_group $cb;
751 824
752 aioreq_pri $pri; 825 aioreq_pri $pri;
753 add $grp aio_scandir $path, 0, sub { 826 add $grp aio_scandir $path, 0, sub {
754 my ($dirs, $nondirs) = @_; 827 my ($dirs, $nondirs) = @_;
755 828
756 my $dirgrp = aio_group sub { 829 my $dirgrp = aio_group sub {
757 add $grp aio_rmdir $path, sub { 830 add $grp aio_rmdir $path, sub {
758 $grp->result ($_[0]); 831 $grp->result ($_[0]);
759 };
760 }; 832 };
761
762 (aioreq_pri $pri), add $dirgrp aio_rmtree "$path/$_" for @$dirs;
763 (aioreq_pri $pri), add $dirgrp aio_unlink "$path/$_" for @$nondirs;
764
765 add $grp $dirgrp;
766 }; 833 };
767 834
768 $grp 835 (aioreq_pri $pri), add $dirgrp aio_rmtree "$path/$_" for @$dirs;
836 (aioreq_pri $pri), add $dirgrp aio_unlink "$path/$_" for @$nondirs;
837
838 add $grp $dirgrp;
769 } 839 };
840
841 $grp
770} 842}
843
844=item aio_sync $callback->($status)
845
846Asynchronously call sync and call the callback when finished.
771 847
772=item aio_fsync $fh, $callback->($status) 848=item aio_fsync $fh, $callback->($status)
773 849
774Asynchronously call fsync on the given filehandle and call the callback 850Asynchronously call fsync on the given filehandle and call the callback
775with the fsync result code. 851with the fsync result code.
779Asynchronously call fdatasync on the given filehandle and call the 855Asynchronously call fdatasync on the given filehandle and call the
780callback with the fdatasync result code. 856callback with the fdatasync result code.
781 857
782If this call isn't available because your OS lacks it or it couldn't be 858If this call isn't available because your OS lacks it or it couldn't be
783detected, it will be emulated by calling C<fsync> instead. 859detected, it will be emulated by calling C<fsync> instead.
860
861=item aio_pathsync $path, $callback->($status)
862
863This request tries to open, fsync and close the given path. This is a
864composite request intended tosync directories after directory operations
865(E.g. rename). This might not work on all operating systems or have any
866specific effect, but usually it makes sure that directory changes get
867written to disc. It works for anything that can be opened for read-only,
868not just directories.
869
870Passes C<0> when everything went ok, and C<-1> on error.
871
872=cut
873
874sub aio_pathsync($;$) {
875 my ($path, $cb) = @_;
876
877 my $pri = aioreq_pri;
878 my $grp = aio_group $cb;
879
880 aioreq_pri $pri;
881 add $grp aio_open $path, O_RDONLY, 0, sub {
882 my ($fh) = @_;
883 if ($fh) {
884 aioreq_pri $pri;
885 add $grp aio_fsync $fh, sub {
886 $grp->result ($_[0]);
887
888 aioreq_pri $pri;
889 add $grp aio_close $fh;
890 };
891 } else {
892 $grp->result (-1);
893 }
894 };
895
896 $grp
897}
784 898
785=item aio_group $callback->(...) 899=item aio_group $callback->(...)
786 900
787This is a very special aio request: Instead of doing something, it is a 901This is a very special aio request: Instead of doing something, it is a
788container for other aio requests, which is useful if you want to bundle 902container for other aio requests, which is useful if you want to bundle
925itself. Useful when you queued a lot of events but got a result early. 1039itself. Useful when you queued a lot of events but got a result early.
926 1040
927=item $grp->result (...) 1041=item $grp->result (...)
928 1042
929Set the result value(s) that will be passed to the group callback when all 1043Set the result value(s) that will be passed to the group callback when all
930subrequests have finished and set thre groups errno to the current value 1044subrequests have finished and set the groups errno to the current value
931of errno (just like calling C<errno> without an error number). By default, 1045of errno (just like calling C<errno> without an error number). By default,
932no argument will be passed and errno is zero. 1046no argument will be passed and errno is zero.
933 1047
934=item $grp->errno ([$errno]) 1048=item $grp->errno ([$errno])
935 1049
1133 1247
1134The default is probably ok in most situations, especially if thread 1248The default is probably ok in most situations, especially if thread
1135creation is fast. If thread creation is very slow on your system you might 1249creation is fast. If thread creation is very slow on your system you might
1136want to use larger values. 1250want to use larger values.
1137 1251
1138=item $oldmaxreqs = IO::AIO::max_outstanding $maxreqs 1252=item IO::AIO::max_outstanding $maxreqs
1139 1253
1140This is a very bad function to use in interactive programs because it 1254This is a very bad function to use in interactive programs because it
1141blocks, and a bad way to reduce concurrency because it is inexact: Better 1255blocks, and a bad way to reduce concurrency because it is inexact: Better
1142use an C<aio_group> together with a feed callback. 1256use an C<aio_group> together with a feed callback.
1143 1257
1144Sets the maximum number of outstanding requests to C<$nreqs>. If you 1258Sets the maximum number of outstanding requests to C<$nreqs>. If you
1145to queue up more than this number of requests, the next call to the 1259do queue up more than this number of requests, the next call to the
1146C<poll_cb> (and C<poll_some> and other functions calling C<poll_cb>) 1260C<poll_cb> (and C<poll_some> and other functions calling C<poll_cb>)
1147function will block until the limit is no longer exceeded. 1261function will block until the limit is no longer exceeded.
1148 1262
1149The default value is very large, so there is no practical limit on the 1263The default value is very large, so there is no practical limit on the
1150number of outstanding requests. 1264number of outstanding requests.
1151 1265
1152You can still queue as many requests as you want. Therefore, 1266You can still queue as many requests as you want. Therefore,
1153C<max_oustsanding> is mainly useful in simple scripts (with low values) or 1267C<max_outstanding> is mainly useful in simple scripts (with low values) or
1154as a stop gap to shield against fatal memory overflow (with large values). 1268as a stop gap to shield against fatal memory overflow (with large values).
1155 1269
1156=back 1270=back
1157 1271
1158=head3 STATISTICAL INFORMATION 1272=head3 STATISTICAL INFORMATION
1180but not yet processed by poll_cb). 1294but not yet processed by poll_cb).
1181 1295
1182=back 1296=back
1183 1297
1184=cut 1298=cut
1185
1186# support function to convert a fd into a perl filehandle
1187sub _fd2fh {
1188 return undef if $_[0] < 0;
1189
1190 # try to generate nice filehandles
1191 my $sym = "IO::AIO::fd#$_[0]";
1192 local *$sym;
1193
1194 open *$sym, "+<&=$_[0]" # usually works under any unix
1195 or open *$sym, "<&=$_[0]" # cygwin needs this
1196 or open *$sym, ">&=$_[0]" # or this
1197 or return undef;
1198
1199 *$sym
1200}
1201 1299
1202min_parallel 8; 1300min_parallel 8;
1203 1301
1204END { flush } 1302END { flush }
1205 1303
1229bytes of memory. In addition, stat requests need a stat buffer (possibly 1327bytes of memory. In addition, stat requests need a stat buffer (possibly
1230a few hundred bytes), readdir requires a result buffer and so on. Perl 1328a few hundred bytes), readdir requires a result buffer and so on. Perl
1231scalars and other data passed into aio requests will also be locked and 1329scalars and other data passed into aio requests will also be locked and
1232will consume memory till the request has entered the done state. 1330will consume memory till the request has entered the done state.
1233 1331
1234This is now awfully much, so queuing lots of requests is not usually a 1332This is not awfully much, so queuing lots of requests is not usually a
1235problem. 1333problem.
1236 1334
1237Per-thread usage: 1335Per-thread usage:
1238 1336
1239In the execution phase, some aio requests require more memory for 1337In the execution phase, some aio requests require more memory for

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines