view release on metacpan or  search on metacpan

etc/bench/bench.pl  view on Meta::CPAN

#!/usr/bin/perl
#
# Compare various cache backends
#
use Benchmark qw(:hireswallclock timethese);
use Capture::Tiny qw(capture);
use Cwd qw(realpath);
use Data::Dump qw(dump);
use DBI;
use DBD::mysql;
use File::Basename;
use File::Path;
use Getopt::Long;
use Hash::MoreUtils qw(slice_def);
use List::Util qw(sum);
use List::MoreUtils qw(uniq);
use Pod::Usage;
use Text::Table;
use Try::Tiny;
use YAML::Any qw(DumpFile);
use Module::Runtime qw(require_module);
use warnings;
use strict;

my %cache_generators = cache_generators();

sub usage {
    pod2usage( -verbose => 1, -exitval => "NOEXIT" );
    print "Valid drivers: " . join( ", ", sort keys(%cache_generators) ) . "\n";
    print "To install all requirements:\n  cpanm "
      . join( " ",
        sort( uniq( map { @{ $_->{req} || [] } } values(%cache_generators) ) ) )
      . "\n";
    exit(1);
}

my $time = 2;
my ( $complex, $drivers_pattern, $help, $incs, $sort_by_name );
usage() if !@ARGV;
GetOptions(
    'd|drivers=s' => \$drivers_pattern,
    'h|help'      => \$help,
    'n'           => \$sort_by_name,
    't|time=s'    => \$time,
    'x|complex'   => \$complex,
) or usage();
usage() if $help || !$drivers_pattern;

my $value =
  $complex
  ? { map { ( $_, scalar( $_ x 100 ) ) } qw(a b c d e) }
  : scalar( 'x' x 500 );
my $num_keys = 1000;

require CHI;

print "CHI version $CHI::VERSION\n" if $CHI::VERSION;

my $cwd  = dirname( realpath($0) );
my $data = "$cwd/data";
rmtree($data);
mkpath( $data, 0, 0775 );

my %common_chi_opts = ( on_get_error => 'die', on_set_error => 'die' );

my %caches;
foreach my $name ( grep { /$drivers_pattern/ } keys(%cache_generators) ) {
    try {
        if ( my $req = $cache_generators{$name}->{req} ) {
            require_module($_) foreach @$req;
        }
        $caches{$name} = $cache_generators{$name}->{code}->();
    }
    catch {
        warn "error initializing '$name', will skip - $_";
    };
}

my @names = sort( keys(%caches) );