benchmarks/lotsa-classes.pl

   1 #!/usr/bin/env perl
   2
   3 use warnings FATAL => 'all';
   4 use strict;
   5 use File::Temp;
   6 use Path::Class;
   7 use String::TT qw(tt strip);
   8
   9 my $number_of_classes = shift || 1500;
  10 my $t = shift || File::Temp->newdir;
  11 my $tmp = dir($t);
  12 $tmp->rmtree;
  13 $tmp->mkpath;
  14 (-d $tmp) or die "not a dir: $tmp";
  15 #print "$tmp\n";
  16
  17 my %class_writer = (
  18     'Moose' => sub {
  19         my $name = shift;
  20         return strip tt q{
  21             package [% name %];
  22             use Moose;
  23             has 'x' => ( is => 'ro', isa => 'Str' );
  24             __PACKAGE__->meta->make_immutable;
  25             1;
  26             __END__
  27         };
  28     },
  29     'Moo' => sub {
  30         my $name = shift;
  31         return strip tt q{
  32             package [% name %];
  33             use Moo;
  34             has 'x' => ( is => 'ro', isa => 'Str' );
  35             1;
  36             __END__
  37         };
  38     },
  39     'Mo' => sub {
  40         my $name = shift;
  41         return strip tt q{
  42             package [% name %];
  43             use Mo;
  44             has 'x' => ( is => 'ro', isa => 'Str' );
  45             1;
  46             __END__
  47         };
  48     },
  49     'Mouse' => sub {
  50         my $name = shift;
  51         return strip tt q{
  52             package [% name %];
  53             use Mouse;
  54             has 'x' => ( is => 'ro', isa => 'Str' );
  55             __PACKAGE__->meta->make_immutable;
  56             1;
  57             __END__
  58         };
  59     },
  60     'plain-package' => sub {
  61         my $name = shift;
  62         return strip tt q{
  63             package [% name %];
  64             sub x {}
  65             1;
  66             __END__
  67         };
  68     },
  69 );
  70
  71 my $class_prefix = 'TmpClassThingy';
  72 my %lib_map;
  73 for my $module (sort keys %class_writer) {
  74     my $lib = $tmp->subdir($module . '-lib');
  75     $lib->mkpath;
  76     my $all_fh = $lib->file('All.pm')->openw;
  77     for my $n (1 .. $number_of_classes) {
  78         my $class_name = $class_prefix . $n;
  79         my $fh = $lib->file($class_name . '.pm')->openw;
  80         $fh->say($class_writer{$module}->($class_name)) or die;
  81         $fh->close or die;
  82         $all_fh->say("use $class_name;");
  83     }
  84     $all_fh->say('1;');
  85     $all_fh->close or die;
  86     $lib_map{$module} = $lib;
  87 }
  88
  89 #$DB::single = 1;
  90 for my $module (sort keys %lib_map) {
  91     my $lib = $lib_map{$module};
  92     print "$module\n";
  93     my $cmd = "time -p $^X -I$lib -MAll -e '1'";
  94     `$cmd > /dev/null 2>&1`; # to cache
  95 #    print "$cmd\n";
  96     system($cmd);
  97     print "\n";
  98 }
  99