view release on metacpan or  search on metacpan

bench/file.pl  view on Meta::CPAN

        my $data = $mmap->data;
        my $len = length($data);
        $mmap->close;
    },
    'file::slurp' => sub {
        my $data = file::slurp($large_file);
        my $len = length($data);
    },
});

# ============================================
# Unlink benchmarks
# ============================================

print "\n--- UNLINK (delete file) ---\n";
my $unlink_file = "$tmpdir/unlink_test.txt";
cmpthese(-2, {
    'file::unlink' => sub {
        file::spew($unlink_file, "x");
        file::unlink($unlink_file);
    },
    'Perl unlink' => sub {
        file::spew($unlink_file, "x");
        unlink($unlink_file);
    },
});

# ============================================
# Copy benchmarks
# ============================================

print "\n--- COPY (small file, 14 bytes) ---\n";
my $copy_src = "$tmpdir/copy_src.txt";
my $copy_dst = "$tmpdir/copy_dst.txt";
file::spew($copy_src, $small_content);
cmpthese(-2, {
    'file::copy' => sub {
        file::copy($copy_src, $copy_dst);
    },
    'File::Copy' => sub {
        require File::Copy;
        File::Copy::copy($copy_src, $copy_dst);
    },
});

print "\n--- COPY (1MB file) ---\n";
cmpthese(-2, {
    'file::copy' => sub {
        file::copy($large_file, $copy_dst);
    },
    'File::Copy' => sub {
        require File::Copy;
        File::Copy::copy($large_file, $copy_dst);
    },
});

# ============================================
# Move benchmarks
# ============================================

print "\n--- MOVE (rename) ---\n";
my $move_src = "$tmpdir/move_src.txt";
my $move_dst = "$tmpdir/move_dst.txt";
cmpthese(-2, {
    'file::move' => sub {
        file::spew($move_src, $small_content);
        file::move($move_src, $move_dst);
    },
    'Perl rename' => sub {
        file::spew($move_src, $small_content);
        rename($move_src, $move_dst);
    },
});

# ============================================
# Touch benchmarks
# ============================================

print "\n--- TOUCH (update mtime) ---\n";
my $touch_file = "$tmpdir/touch.txt";
file::spew($touch_file, "x");
cmpthese(-2, {
    'file::touch' => sub {
        file::touch($touch_file);
    },
    'Perl utime' => sub {
        utime(undef, undef, $touch_file);
    },
});

# ============================================
# mkdir/rmdir benchmarks
# ============================================

print "\n--- MKDIR/RMDIR ---\n";
my $bench_dir = "$tmpdir/benchdir";
cmpthese(-2, {
    'file::mkdir/rmdir' => sub {
        file::mkdir($bench_dir);
        file::rmdir($bench_dir);
    },
    'Perl mkdir/rmdir' => sub {
        mkdir($bench_dir);
        rmdir($bench_dir);
    },
});

# ============================================
# Readdir benchmarks
# ============================================

print "\n--- READDIR (100 files) ---\n";
my $readdir_dir = "$tmpdir/readdir_test";
file::mkdir($readdir_dir);
for my $i (1..100) {
    file::spew("$readdir_dir/file_$i.txt", "x");
}
cmpthese(-2, {
    'file::readdir' => sub {
        my $entries = file::readdir($readdir_dir);
    },
    'Perl opendir/readdir' => sub {
        opendir my $dh, $readdir_dir or die;
        my @entries = grep { $_ ne '.' && $_ ne '..' } readdir($dh);
        closedir $dh;
    },
});

# ============================================
# Path manipulation benchmarks
# ============================================

bench/file.pl  view on Meta::CPAN

        my $d = File::Basename::dirname($test_path);
    },
});

print "\n--- EXTNAME ---\n";
cmpthese(-2, {
    'file::extname' => sub {
        my $e = file::extname($test_path);
    },
    'Perl regex' => sub {
        my ($e) = $test_path =~ /(\.[^.\/]+)$/;
    },
});

# ============================================
# Head/Tail benchmarks
# ============================================

print "\n--- HEAD (first 10 lines of 1000 line file) ---\n";
cmpthese(-2, {
    'file::head' => sub {
        my $h = file::head($lines_file, 10);
    },
    'Perl readline' => sub {
        open my $fh, '<', $lines_file or die;
        my @lines;
        my $count = 0;
        while (<$fh>) {
            chomp;
            push @lines, $_;
            last if ++$count >= 10;
        }
        close $fh;
    },
});

print "\n--- TAIL (last 10 lines of 1000 line file) ---\n";
cmpthese(-2, {
    'file::tail' => sub {
        my $t = file::tail($lines_file, 10);
    },
    'Perl (slurp all)' => sub {
        open my $fh, '<', $lines_file or die;
        my @all = <$fh>;
        chomp @all;
        close $fh;
        my @lines = @all[-10..-1];
    },
});

# ============================================
# Atomic spew benchmarks
# ============================================

print "\n--- ATOMIC_SPEW (safe write, 10KB) ---\n";
my $atomic_file = "$tmpdir/atomic.txt";
cmpthese(-2, {
    'file::atomic_spew' => sub {
        file::atomic_spew($atomic_file, $medium_content);
    },
    'Perl temp+rename' => sub {
        my $tmp = "$atomic_file.tmp.$$";
        open my $fh, '>', $tmp or die;
        print $fh $medium_content;
        close $fh;
        rename $tmp, $atomic_file;
    },
});

# ============================================
# Additional stat benchmarks
# ============================================

print "\n--- ATIME ---\n";
cmpthese(-2, {
    'file::atime' => sub {
        my $a = file::atime($small_file);
    },
    'Perl stat atime' => sub {
        my $a = (stat($small_file))[8];
    },
});

print "\n--- MODE ---\n";
cmpthese(-2, {
    'file::mode' => sub {
        my $m = file::mode($small_file);
    },
    'Perl stat mode' => sub {
        my $m = (stat($small_file))[2] & 07777;
    },
});

print "\n--- IS_LINK ---\n";
cmpthese(-2, {
    'file::is_link' => sub {
        my $l = file::is_link($small_file);
    },
    'Perl -l' => sub {
        my $l = -l $small_file;
    },
});

print "\n=== Summary ===\n";
print "file:: uses direct syscalls bypassing PerlIO overhead\n";
print "\n";
print "Performance highlights:\n";
print "  - Large file slurp:  ~2.7x faster (pre-allocated buffer)\n";
print "  - Large file spew:   ~3x faster (direct write)\n";
print "  - Lines array:       ~2x faster (optimized split)\n";
print "  - Copy large file:   ~1.5-2x faster (direct syscalls)\n";
print "  - Readdir:           ~1.3x faster (no OO overhead)\n";
print "  - Basename/Dirname:  ~3-5x faster (no module load, pure C)\n";
print "  - Head:              ~2x faster (early termination)\n";
print "\n";
print "Custom ops (file_* functions) vs method calls:\n";
print "  - file_slurp:    2-3% faster than file::slurp\n";
print "  - file_spew:     2-6% faster than file::spew\n";
print "  - file_unlink:   2-5% faster than file::unlink\n";
print "  - file_mkdir:    2-5% faster than file::mkdir\n";
print "  - file_basename: 2-5% faster than file::basename\n";
print "\n";
print "Usage:\n";
print "  use file qw(import);  # Import file_slurp, file_spew, etc.\n";
print "  my \$c = file_slurp(\$path);  # Uses custom op\n";
print "\n";