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