#!/usr/bin/perl
use strict;
use warnings;
use utf8;

use Fcntl qw();
use Time::HiRes qw();

my $testfile = shift or die "Specify a test file";
die "$testfile doesn't exist" unless -f $testfile;

my @benchmarks = (
    \&bench1_native,
#    \&bench1_raw,
#    \&bench1_mmap,
    \&bench1_raw_perlio,
    \&bench1_raw_perlio_utf8,
    \&bench1_win32,

    \&bench2_native,
    \&bench2_raw_perlio,
    \&bench2_raw_perlio_utf8,

    \&bench3
);

foreach my $bench (@benchmarks)
{
    my ($secs, $bytes, $lines) = $bench->($testfile);
    my $mb = $bytes / 1_000_000;
    print sprintf("  %.1f MB in %.3f sec, %.1f MB/sec\n", $mb, $secs, $mb / $secs);
    print sprintf("  %1.fK lines, %.2f KL/sec\n", $lines / 1_000, ($lines / 1_000) / $secs) if defined($lines);
}

# ------------------------------------------------------------------

# Read a line at a time with <fh>

sub bench1_native { return bench1_common(@_, "Line-at-a-time, default layers", "<"); }
sub bench1_raw { return bench1_common(@_, "Line-at-a-time, :raw", "<:raw"); }
sub bench1_mmap { return bench1_common(@_, "Line-at-a-time, :raw:mmap", "<:raw:mmap"); }
sub bench1_raw_perlio { return bench1_common(@_, "Line-at-a-time, :raw:perlio", "<:raw:perlio"); }
sub bench1_raw_perlio_utf8 { return bench1_common(@_, "Line-at-a-time, :raw:perlio:utf8", "<:raw:perlio:utf8"); }
sub bench1_win32 { return bench1_common(@_, "Line-at-a-time, :win32:perlio", "<:win32:perlio"); }

sub bench1_common
{
    my ($file, $prompt, $discipline) = @_;
    
    print "\n$prompt\n";
    
    open(my $fh, $discipline, $file) or die;
    my $size = -s $fh;

    # my $lines = 0;
    my $bytes = 0;
    my $start_time = Time::HiRes::time();
    while (<$fh>)
    {
        use bytes;
        # $lines += 1;
        $bytes += length($_);
    }
    my $end_time = Time::HiRes::time();

    close($fh);
    print "  $size on disk, $bytes in memory\n" if $bytes != $size;

    my $secs = $end_time - $start_time;
    # return ($secs, $size, $lines);
    return ($secs, $size);
}

# ------------------------------------------------------------------

sub bench2_native { return bench2_common(@_, "Slurp-into-scalar, default layers", "<"); }
sub bench2_raw_perlio { return bench2_common(@_, "Slurp-into-scalar, :raw:perlio", "<:raw:perlio"); }
sub bench2_raw_perlio_utf8 { return bench2_common(@_, "Slurp-into-scalar, :raw:perlio:utf8", "<:raw:perlio:utf8"); }

# Read whole file with <fh>
sub bench2_common
{
    my ($file, $prompt, $discipline) = @_;

    print "\n$prompt\n";

    open(my $fh, $discipline, $file) or die;
    my $size = -s $fh;
    local $/ = undef;

    my $buf = "";
    vec($buf, $size, 8) = 0;

    my $start_time = Time::HiRes::time();
    $buf = <$fh>;
    my $end_time = Time::HiRes::time();

    close($fh);

    my $bufsize = length($buf);
    # die "file is $size but got $bufsize" unless $bufsize == $size;
    print "  $size on disk, $bufsize in memory\n" if $bufsize != $size;
    
    my $secs = $end_time - $start_time;
    return ($secs, $size);
}

# ------------------------------------------------------------------

# Read whole file with sysopen/sysread
sub bench3
{
    my ($file) = @_;

    print "\n";
    print "Slurp into scalar with sysopen/sysread (single read)\n";

    sysopen(my $fh, $file, Fcntl::O_RDONLY | Fcntl::O_BINARY) or die;
    my $size = -s $fh;
    local $/ = undef;

    my $buf = "";
    vec($buf, $size, 8) = 0;

    my $start_time = Time::HiRes::time();
    my $count = sysread($fh, $buf, $size);
    my $end_time = Time::HiRes::time();

    die "read error: $!" unless defined($count) && $count == $size;
    close($fh);

    my $bufsize = length($buf);
    die "file is $size but got $bufsize" unless $bufsize == $size;
    
    my $secs = $end_time - $start_time;
    return ($secs, $size);
}