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
   8 my $number_of_classes = shift || 1500;
   9 my $number_of_attributes = shift || 20;
  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         my $attrs = join '', map { "has '$_' => ( is => 'ro', isa => 'Str' );\n" } @_;
  21         return qq{package $name;\nuse Moose;\n$attrs\n1;\n__END__\n};
  22     },
  23     'MooseImmutable' => sub {
  24         my $name = shift;
  25         my $attrs = join '', map { "has '$_' => ( is => 'ro', isa => 'Str' );\n" } @_;
  26         return qq{package $name;\nuse Moose;\n$attrs\n__PACKAGE__->meta->make_immutable;\n1;\n__END__\n};
  27     },
  28     'Moo' => sub {
  29         my $name = shift;
  30         my $attrs = join'', map { "has '$_' => ( is => 'ro', isa => 'Str' );\n" } @_;
  31         return qq{package $name;\nuse Moo;\n$attrs\n1;\n__END__\n};
  32     },
  33     'Mo' => sub {
  34         my $name = shift;
  35         my $attrs = join'', map { "has '$_' => ( is => 'ro', isa => 'Str' );\n" } @_;
  36         return qq{package $name;\nuse Mo;\n$attrs\n1;\n__END__\n};
  37     },
  38     'Mouse' => sub {
  39         my $name = shift;
  40         my $attrs = join'', map { "has '$_' => ( is => 'ro', isa => 'Str' );\n" } @_;
  41         return qq{package $name;\nuse Mouse;\n$attrs\n1;\n__END__\n};
  42     },
  43     'plain-package' => sub {
  44         my $name = shift;
  45         my $attrs = join'', map { "sub $_ {}\n" } @_;
  46         return qq{package $name;\n$attrs\n1;\n__END__\n};
  47     },
  48 );
  49
  50 my $class_prefix = 'TmpClassThingy';
  51 my %lib_map;
  52 my @attribute_names = map { 'a' . $_ } 1 .. $number_of_attributes;
  53 for my $module (sort keys %class_writer) {
  54     my $lib = $tmp->subdir($module . '-lib');
  55     $lib->mkpath;
  56     my $all_fh = $lib->file('All.pm')->openw;
  57     for my $n (1 .. $number_of_classes) {
  58         my $class_name = $class_prefix . $n;
  59         my $fh = $lib->file($class_name . '.pm')->openw;
  60         $fh->say($class_writer{$module}->($class_name, @attribute_names)) or die;
  61         $fh->close or die;
  62         $all_fh->say("use $class_name;") or die;
  63     }
  64     $all_fh->say('1;') or die;
  65     $all_fh->close or die;
  66     $lib_map{$module} = $lib;
  67 }
  68
  69 #$DB::single = 1;
  70 for my $module (sort keys %lib_map) {
  71     my $lib = $lib_map{$module};
  72     print "$module\n";
  73     my $cmd = "time -p $^X -I$lib -MAll -e '1'";
  74     `$cmd > /dev/null 2>&1`; # to cache
  75 #    print "$cmd\n";
  76     system($cmd);
  77     print "\n";
  78 }
  79