#!/usr/bin/env perl
#
# Benchmark: Compare XS vs Pure Perl utilities
#
use strict;
use warnings;
use Benchmark qw(cmpthese timethese);
use Time::HiRes ();
use Data::Dumper ();
use POSIX qw(strftime);

use lib '../blib/lib', '../blib/arch';
use Medusa::XS;

print "=" x 60, "\n";
print "Medusa::XS Performance Benchmarks\n";
print "=" x 60, "\n\n";

#---------------------------------------------------------------
# Benchmark 1: GUID Generation
#---------------------------------------------------------------
print "1. GUID Generation\n";
print "-" x 40, "\n";

# Pure Perl equivalent (simulated Data::GUID style)
sub perl_guid {
    my @chars = ('0'..'9', 'a'..'f');
    my $guid = '';
    for my $len (8, 4, 4, 4, 12) {
        $guid .= join('', map { $chars[int(rand(16))] } 1..$len);
        $guid .= '-' if length($guid) < 36;
    }
    return $guid;
}

cmpthese(100000, {
    'XS::generate_guid' => sub { Medusa::XS::generate_guid() },
    'Perl GUID'         => sub { perl_guid() },
});

print "\n";

#---------------------------------------------------------------
# Benchmark 2: Caller Stack Collection
#---------------------------------------------------------------
print "2. Caller Stack Collection (5 levels deep)\n";
print "-" x 40, "\n";

sub perl_caller_stack {
    my ($n, $stack) = (0, "");
    while (my @l = (caller($n))) {
        $stack .= "->" if $stack;
        $stack = sprintf "%s%s:%s", $stack, $l[0], $l[2];
        $n++;
    }
    return $stack;
}

sub level1 { level2() }
sub level2 { level3() }
sub level3 { level4() }
sub level4 { level5() }
sub level5 { 
    return {
        xs   => Medusa::XS::collect_caller_stack(),
        perl => perl_caller_stack(),
    };
}

# Warm up
level1();

cmpthese(50000, {
    'XS::collect_caller_stack' => sub { level1()->{xs} },
    'Perl caller() loop'       => sub { level1()->{perl} },
});

print "\n";

#---------------------------------------------------------------
# Benchmark 3: Timestamp Formatting
#---------------------------------------------------------------
print "3. Timestamp Formatting\n";
print "-" x 40, "\n";

sub perl_format_time {
    my @now = gmtime;
    return strftime('%a %b %e %H:%M:%S %Y', @now);
}

cmpthese(100000, {
    'XS::format_time'  => sub { Medusa::XS::format_time(1) },
    'Perl strftime'    => sub { perl_format_time() },
});

print "\n";

#---------------------------------------------------------------
# Benchmark 4: Data::Dumper Cleanup  
#---------------------------------------------------------------
print "4. Data::Dumper Output Cleanup\n";
print "-" x 40, "\n";

my $dumper_input = Data::Dumper::Dumper({ key => 'value', nested => { a => 1, b => [1,2,3] } });

sub perl_clean_dumper {
    my $data = shift;
    $data =~ s/\$VAR1\s=\s//;
    $data =~ s/(\s+)(['"][^"]+['"])*/defined $2 ? $2 : ""/gem;
    $data =~ s/;$//;
    return $data;
}

cmpthese(50000, {
    'XS::clean_dumper' => sub { Medusa::XS::clean_dumper($dumper_input) },
    'Perl regex'       => sub { perl_clean_dumper($dumper_input) },
});

print "\n";

#---------------------------------------------------------------
# Benchmark 5: Full Audit Wrapper Overhead
#---------------------------------------------------------------
print "5. Full :Audit Wrapper Overhead\n";
print "-" x 40, "\n";

# Set up mock logger
{
    package MockLogger;
    sub new { bless {}, shift }
    sub debug { }
    sub info { }
    sub error { }
}

$Medusa::XS::LOG{LOG} = MockLogger->new();

{
    package BenchPkg;
    use Medusa::XS;
    
    sub audited_add :Audit {
        my ($a, $b) = @_;
        return $a + $b;
    }
    
    sub plain_add {
        my ($a, $b) = @_;
        return $a + $b;
    }
}

cmpthese(10000, {
    'audited_add'   => sub { BenchPkg::audited_add(1, 2) },
    'plain_add'     => sub { BenchPkg::plain_add(1, 2) },
});

print "\n";
print "=" x 60, "\n";
print "Benchmark complete.\n";
print "XS utilities provide significant speedup for:\n";
print "  - GUID generation (arc4random vs Perl rand)\n";
print "  - Caller stack (cx_stack walk vs caller() loop)\n";
print "  - Timestamp (direct strftime vs Perl strftime)\n";
print "  - Dumper cleanup (C state machine vs Perl regex)\n";
print "=" x 60, "\n";
