view release on metacpan or  search on metacpan

bench/file.pl  view on Meta::CPAN

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";
print "All file:: functions:\n";
print "  I/O:      slurp, slurp_raw, spew, append, atomic_spew\n";
print "  Lines:    lines, lines_iter, each_line, head, tail\n";
print "  Stat:     size, mtime, atime, ctime, mode, exists\n";
print "  Type:     is_file, is_dir, is_link, is_readable, is_writable, is_executable\n";
print "  Ops:      unlink, copy, move, touch, chmod, mkdir, rmdir, readdir\n";
print "  Path:     basename, dirname, extname, join\n";
print "  Memory:   mmap_open (returns object with data, sync, close methods)\n";