File Coverage

blib/lib/IO/AIO/Util.pm

Criterion	Covered	Total	%
statement	42	42	100.0
branch	8	8	100.0
condition	10	13	76.9
subroutine	8	8	100.0
pod	1	1	100.0
total	69	72	95.8

package IO::AIO::Util;

use strict;
use warnings;

use Exporter qw(import);
use IO::AIO 2;
use File::Spec::Functions qw(
    canonpath catpath catdir splitdir splitpath updir
);
use POSIX ();

our $VERSION = '0.10';
$VERSION = eval $VERSION;

our @EXPORT_OK = qw(aio_mkpath aio_mktree);

sub aio_mkpath {
    my ($path, $mode, $cb) = @_;

    my $pri = aioreq_pri;
    my $grp = aio_group $cb;

    # Default is success.
    local $!;
    $grp->result(0);

    # Clean up the path.
    $path = canonpath($path);

    my ($vol, $dir, undef) = splitpath($path, 1);
    my @dir = splitdir($dir);
    my $idx = 0;

    my $sub; $sub = sub {
        for (; $idx < @dir; $idx++) {
            # Root and parent directories are assumed to always exist.
            last if '' ne $dir[$idx] and updir ne $dir[$idx];
        }
        return $grp if @dir <= $idx;

        my $path = catpath($vol, catdir(@dir[0 .. $idx]), '');

        aioreq_pri $pri;
        add $grp aio_mkdir $path, $mode, sub {
            $idx++ and return $sub->() unless $_[0];

            # Ignore "file exists" errors unless it is the last component,
            # then stat it to ensure it is a directory. This matches
            # the behaviour of `mkdir -p` from GNU coreutils.
            $idx++ and return $sub->() if &POSIX::EEXIST == $!
                and not ($idx == $#dir and not -d $path);

            $grp->cancel_subs;
            $grp->errno($!);
            $grp->result($_[0]);
            return $grp;
        };
    };

    return $sub->();
}

*aio_mktree = \&aio_mkpath;


1;

__END__