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.122 by root, Sat Apr 26 12:00:23 2008 UTC vs.
Revision 1.123 by root, Sat May 10 18:06:41 2008 UTC

… …
204 aio_fdatasync aio_pathsync aio_readahead 204 aio_fdatasync aio_pathsync aio_readahead
205 aio_rename aio_link aio_move aio_copy aio_group 205 aio_rename aio_link aio_move aio_copy aio_group
206 aio_nop aio_mknod aio_load aio_rmtree aio_mkdir aio_chown 206 aio_nop aio_mknod aio_load aio_rmtree aio_mkdir aio_chown
207 aio_chmod aio_utime aio_truncate); 207 aio_chmod aio_utime aio_truncate);
208 208
209 our @EXPORT = (@AIO_REQ, qw(aioreq_pri aioreq_nice aio_block)); 209 our @EXPORT = (@AIO_REQ, qw(aioreq_pri aioreq_nice));
210 our @EXPORT_OK = qw(poll_fileno poll_cb poll_wait flush 210 our @EXPORT_OK = qw(poll_fileno poll_cb poll_wait flush
211 min_parallel max_parallel max_idle 211 min_parallel max_parallel max_idle
212 nreqs nready npending nthreads 212 nreqs nready npending nthreads
213 max_poll_time max_poll_reqs); 213 max_poll_time max_poll_reqs);
214 214
… …
540memory. Status is the same as with aio_read. 540memory. Status is the same as with aio_read.
541 541
542=cut 542=cut
543 543
544sub aio_load($$;$) { 544sub aio_load($$;$) {
545 aio_block {
546 my ($path, undef, $cb) = @_; 545 my ($path, undef, $cb) = @_;
547 my $data = \$_[1]; 546 my $data = \$_[1];
548 547
549 my $pri = aioreq_pri; 548 my $pri = aioreq_pri;
550 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);
551 555
552 aioreq_pri $pri; 556 aioreq_pri $pri;
553 add $grp aio_open $path, O_RDONLY, 0, sub {
554 my $fh = shift
555 or return $grp->result (-1);
556
557 aioreq_pri $pri;
558 add $grp aio_read $fh, 0, (-s $fh), $$data, 0, sub { 557 add $grp aio_read $fh, 0, (-s $fh), $$data, 0, sub {
559 $grp->result ($_[0]); 558 $grp->result ($_[0]);
560 };
561 }; 559 };
562
563 $grp
564 } 560 };
561
562 $grp
565} 563}
566 564
567=item aio_copy $srcpath, $dstpath, $callback->($status) 565=item aio_copy $srcpath, $dstpath, $callback->($status)
568 566
569Try 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
… …
580errors are being ignored. 578errors are being ignored.
581 579
582=cut 580=cut
583 581
584sub aio_copy($$;$) { 582sub aio_copy($$;$) {
585 aio_block {
586 my ($src, $dst, $cb) = @_; 583 my ($src, $dst, $cb) = @_;
587 584
588 my $pri = aioreq_pri; 585 my $pri = aioreq_pri;
589 my $grp = aio_group $cb; 586 my $grp = aio_group $cb;
590 587
591 aioreq_pri $pri; 588 aioreq_pri $pri;
592 add $grp aio_open $src, O_RDONLY, 0, sub { 589 add $grp aio_open $src, O_RDONLY, 0, sub {
593 if (my $src_fh = $_[0]) { 590 if (my $src_fh = $_[0]) {
594 my @stat = stat $src_fh; 591 my @stat = stat $src_fh;
595 592
596 aioreq_pri $pri; 593 aioreq_pri $pri;
597 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 {
598 if (my $dst_fh = $_[0]) { 595 if (my $dst_fh = $_[0]) {
599 aioreq_pri $pri; 596 aioreq_pri $pri;
600 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 {
601 if ($_[0] == $stat[7]) { 598 if ($_[0] == $stat[7]) {
602 $grp->result (0); 599 $grp->result (0);
603 close $src_fh; 600 close $src_fh;
604 601
605 # those should not normally block. should. should. 602 # those should not normally block. should. should.
606 utime $stat[8], $stat[9], $dst; 603 utime $stat[8], $stat[9], $dst;
607 chmod $stat[2] & 07777, $dst_fh; 604 chmod $stat[2] & 07777, $dst_fh;
608 chown $stat[4], $stat[5], $dst_fh; 605 chown $stat[4], $stat[5], $dst_fh;
609 606
610 aioreq_pri $pri; 607 aioreq_pri $pri;
611 add $grp aio_close $dst_fh; 608 add $grp aio_close $dst_fh;
612 } else { 609 } else {
613 $grp->result (-1); 610 $grp->result (-1);
614 close $src_fh; 611 close $src_fh;
615 close $dst_fh; 612 close $dst_fh;
616 613
617 aioreq $pri; 614 aioreq $pri;
618 add $grp aio_unlink $dst; 615 add $grp aio_unlink $dst;
619 }
620 }; 616 }
621 } else {
622 $grp->result (-1);
623 } 617 };
618 } else {
619 $grp->result (-1);
624 }, 620 }
625
626 } else {
627 $grp->result (-1);
628 } 621 },
622
623 } else {
624 $grp->result (-1);
629 }; 625 }
630
631 $grp
632 } 626 };
627
628 $grp
633} 629}
634 630
635=item aio_move $srcpath, $dstpath, $callback->($status) 631=item aio_move $srcpath, $dstpath, $callback->($status)
636 632
637Try 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
… …
643that is successful, unlinking the C<$srcpath>. 639that is successful, unlinking the C<$srcpath>.
644 640
645=cut 641=cut
646 642
647sub aio_move($$;$) { 643sub aio_move($$;$) {
648 aio_block {
649 my ($src, $dst, $cb) = @_; 644 my ($src, $dst, $cb) = @_;
650 645
651 my $pri = aioreq_pri; 646 my $pri = aioreq_pri;
652 my $grp = aio_group $cb; 647 my $grp = aio_group $cb;
653 648
654 aioreq_pri $pri; 649 aioreq_pri $pri;
655 add $grp aio_rename $src, $dst, sub { 650 add $grp aio_rename $src, $dst, sub {
656 if ($_[0] && $! == EXDEV) { 651 if ($_[0] && $! == EXDEV) {
657 aioreq_pri $pri; 652 aioreq_pri $pri;
658 add $grp aio_copy $src, $dst, sub { 653 add $grp aio_copy $src, $dst, sub {
659 $grp->result ($_[0]);
660
661 if (!$_[0]) {
662 aioreq_pri $pri;
663 add $grp aio_unlink $src;
664 }
665 };
666 } else {
667 $grp->result ($_[0]); 654 $grp->result ($_[0]);
655
656 if (!$_[0]) {
657 aioreq_pri $pri;
658 add $grp aio_unlink $src;
659 }
668 } 660 };
661 } else {
662 $grp->result ($_[0]);
669 }; 663 }
670
671 $grp
672 } 664 };
665
666 $grp
673} 667}
674 668
675=item aio_scandir $path, $maxreq, $callback->($dirs, $nondirs) 669=item aio_scandir $path, $maxreq, $callback->($dirs, $nondirs)
676 670
677Scans a directory (similar to C<aio_readdir>) but additionally tries to 671Scans a directory (similar to C<aio_readdir>) but additionally tries to
… …
725directory counting heuristic. 719directory counting heuristic.
726 720
727=cut 721=cut
728 722
729sub aio_scandir($$;$) { 723sub aio_scandir($$;$) {
730 aio_block {
731 my ($path, $maxreq, $cb) = @_; 724 my ($path, $maxreq, $cb) = @_;
732 725
733 my $pri = aioreq_pri; 726 my $pri = aioreq_pri;
734 727
735 my $grp = aio_group $cb; 728 my $grp = aio_group $cb;
736 729
737 $maxreq = 4 if $maxreq <= 0; 730 $maxreq = 4 if $maxreq <= 0;
738 731
739 # 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
740 aioreq_pri $pri; 740 aioreq_pri $pri;
741 add $grp aio_stat $path, sub { 741 add $grp aio_readdir $path, sub {
742 my $entries = shift
742 return $grp->result () if $_[0]; 743 or return $grp->result ();
743 my $now = time;
744 my $hash1 = join ":", (stat _)[0,1,3,7,9];
745 744
746 # read the directory entries 745 # stat the dir another time
747 aioreq_pri $pri; 746 aioreq_pri $pri;
748 add $grp aio_readdir $path, sub {
749 my $entries = shift
750 or return $grp->result ();
751
752 # stat the dir another time
753 aioreq_pri $pri;
754 add $grp aio_stat $path, sub { 747 add $grp aio_stat $path, sub {
755 my $hash2 = join ":", (stat _)[0,1,3,7,9]; 748 my $hash2 = join ":", (stat _)[0,1,3,7,9];
756 749
757 my $ndirs; 750 my $ndirs;
758 751
759 # take the slow route if anything looks fishy 752 # take the slow route if anything looks fishy
760 if ($hash1 ne $hash2 or (stat _)[9] == $now) { 753 if ($hash1 ne $hash2 or (stat _)[9] == $now) {
761 $ndirs = -1; 754 $ndirs = -1;
762 } else { 755 } else {
763 # if nlink == 2, we are finished 756 # if nlink == 2, we are finished
764 # on non-posix-fs's, we rely on nlink < 2 757 # on non-posix-fs's, we rely on nlink < 2
765 $ndirs = (stat _)[3] - 2 758 $ndirs = (stat _)[3] - 2
766 or return $grp->result ([], $entries); 759 or return $grp->result ([], $entries);
767 } 760 }
768 761
769 # sort into likely dirs and likely nondirs 762 # sort into likely dirs and likely nondirs
770 # dirs == files without ".", short entries first 763 # dirs == files without ".", short entries first
771 $entries = [map $_->[0], 764 $entries = [map $_->[0],
772 sort { $b->[1] cmp $a->[1] } 765 sort { $b->[1] cmp $a->[1] }
773 map [$_, sprintf "%s%04d", (/.\./ ? "1" : "0"), length], 766 map [$_, sprintf "%s%04d", (/.\./ ? "1" : "0"), length],
774 @$entries]; 767 @$entries];
775 768
776 my (@dirs, @nondirs); 769 my (@dirs, @nondirs);
777 770
778 my $statgrp = add $grp aio_group sub { 771 my $statgrp = add $grp aio_group sub {
779 $grp->result (\@dirs, \@nondirs); 772 $grp->result (\@dirs, \@nondirs);
780 }; 773 };
781 774
782 limit $statgrp $maxreq; 775 limit $statgrp $maxreq;
783 feed $statgrp sub { 776 feed $statgrp sub {
784 return unless @$entries; 777 return unless @$entries;
785 my $entry = pop @$entries; 778 my $entry = pop @$entries;
786 779
787 aioreq_pri $pri; 780 aioreq_pri $pri;
788 add $statgrp aio_stat "$path/$entry/.", sub { 781 add $statgrp aio_stat "$path/$entry/.", sub {
789 if ($_[0] < 0) { 782 if ($_[0] < 0) {
790 push @nondirs, $entry; 783 push @nondirs, $entry;
791 } else { 784 } else {
792 # need to check for real directory 785 # need to check for real directory
793 aioreq_pri $pri; 786 aioreq_pri $pri;
794 add $statgrp aio_lstat "$path/$entry", sub { 787 add $statgrp aio_lstat "$path/$entry", sub {
795 if (-d _) { 788 if (-d _) {
796 push @dirs, $entry; 789 push @dirs, $entry;
797 790
798 unless (--$ndirs) { 791 unless (--$ndirs) {
799 push @nondirs, @$entries; 792 push @nondirs, @$entries;
800 feed $statgrp; 793 feed $statgrp;
801 }
802 } else {
803 push @nondirs, $entry;
804 } 794 }
795 } else {
796 push @nondirs, $entry;
805 } 797 }
806 } 798 }
807 }; 799 }
808 }; 800 };
809 }; 801 };
810 }; 802 };
811 }; 803 };
812
813 $grp
814 } 804 };
805
806 $grp
815} 807}
816 808
817=item aio_rmtree $path, $callback->($status) 809=item aio_rmtree $path, $callback->($status)
818 810
819Delete a directory tree starting (and including) C<$path>, return the 811Delete a directory tree starting (and including) C<$path>, return the
… …
823 815
824=cut 816=cut
825 817
826sub aio_rmtree; 818sub aio_rmtree;
827sub aio_rmtree($;$) { 819sub aio_rmtree($;$) {
828 aio_block {
829 my ($path, $cb) = @_; 820 my ($path, $cb) = @_;
830 821
831 my $pri = aioreq_pri; 822 my $pri = aioreq_pri;
832 my $grp = aio_group $cb; 823 my $grp = aio_group $cb;
833 824
834 aioreq_pri $pri; 825 aioreq_pri $pri;
835 add $grp aio_scandir $path, 0, sub { 826 add $grp aio_scandir $path, 0, sub {
836 my ($dirs, $nondirs) = @_; 827 my ($dirs, $nondirs) = @_;
837 828
838 my $dirgrp = aio_group sub { 829 my $dirgrp = aio_group sub {
839 add $grp aio_rmdir $path, sub { 830 add $grp aio_rmdir $path, sub {
840 $grp->result ($_[0]); 831 $grp->result ($_[0]);
841 };
842 }; 832 };
843
844 (aioreq_pri $pri), add $dirgrp aio_rmtree "$path/$_" for @$dirs;
845 (aioreq_pri $pri), add $dirgrp aio_unlink "$path/$_" for @$nondirs;
846
847 add $grp $dirgrp;
848 }; 833 };
849 834
850 $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;
851 } 839 };
840
841 $grp
852} 842}
853 843
854=item aio_sync $callback->($status) 844=item aio_sync $callback->($status)
855 845
856Asynchronously call sync and call the callback when finished. 846Asynchronously call sync and call the callback when finished.
… …
880Passes C<0> when everything went ok, and C<-1> on error. 870Passes C<0> when everything went ok, and C<-1> on error.
881 871
882=cut 872=cut
883 873
884sub aio_pathsync($;$) { 874sub aio_pathsync($;$) {
885 aio_block {
886 my ($path, $cb) = @_; 875 my ($path, $cb) = @_;
887 876
888 my $pri = aioreq_pri; 877 my $pri = aioreq_pri;
889 my $grp = aio_group $cb; 878 my $grp = aio_group $cb;
890 879
891 aioreq_pri $pri; 880 aioreq_pri $pri;
892 add $grp aio_open $path, O_RDONLY, 0, sub { 881 add $grp aio_open $path, O_RDONLY, 0, sub {
893 my ($fh) = @_; 882 my ($fh) = @_;
894 if ($fh) { 883 if ($fh) {
884 aioreq_pri $pri;
885 add $grp aio_fsync $fh, sub {
886 $grp->result ($_[0]);
887
895 aioreq_pri $pri; 888 aioreq_pri $pri;
896 add $grp aio_fsync $fh, sub {
897 $grp->result ($_[0]);
898
899 aioreq_pri $pri;
900 add $grp aio_close $fh; 889 add $grp aio_close $fh;
901 };
902 } else {
903 $grp->result (-1);
904 } 890 };
891 } else {
892 $grp->result (-1);
905 }; 893 }
906
907 $grp
908 } 894 };
895
896 $grp
909} 897}
910 898
911=item aio_group $callback->(...) 899=item aio_group $callback->(...)
912 900
913This 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
… …
1259 1247
1260The default is probably ok in most situations, especially if thread 1248The default is probably ok in most situations, especially if thread
1261creation 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
1262want to use larger values. 1250want to use larger values.
1263 1251
1264=item $oldmaxreqs = IO::AIO::max_outstanding $maxreqs 1252=item IO::AIO::max_outstanding $maxreqs
1265 1253
1266This 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
1267blocks, 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
1268use an C<aio_group> together with a feed callback. 1256use an C<aio_group> together with a feed callback.
1269 1257
… …
1274 1262
1275The 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
1276number of outstanding requests. 1264number of outstanding requests.
1277 1265
1278You can still queue as many requests as you want. Therefore, 1266You can still queue as many requests as you want. Therefore,
1279C<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
1280as 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).
1281 1269
1282=back 1270=back
1283 1271
1284=head3 STATISTICAL INFORMATION 1272=head3 STATISTICAL INFORMATION

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines