A mutable class will throw errors from inside CMOP, and that's expected
[gitmo/Moose.git] / benchmarks / moose_bench.pl
CommitLineData
5ee2a036 1#!/usr/bin/env perl
2use strict;
3use warnings;
4use Time::HiRes 'time';
5use List::Util 'sum';
6use IPC::System::Simple 'system';
7use autodie;
8use Parse::BACKPAN::Packages;
9use LWP::Simple;
10use Archive::Tar;
11use File::Slurp 'slurp';
12
13my $backpan = Parse::BACKPAN::Packages->new;
14my @cmops = $backpan->distributions('Class-MOP');
15my @mooses = $backpan->distributions('Moose');
16
17my $cmop_version = 0;
18my $cmop_dir;
19
20my $base = "http://backpan.cpan.org/";
21
ee16bf2b 22my %time;
23my %mem;
24
25open my $output, ">", "moose_bench.txt";
26
5ee2a036 27for my $moose (@mooses) {
28 my $moose_dir = build($moose);
29
30 # Find the CMOP dependency
31 my $makefile = slurp("$moose_dir/Makefile.PL");
32 my ($cmop_dep) = $makefile =~ /Class::MOP.*?([0-9._]+)/
33 or die "Unable to find Class::MOP version dependency in $moose_dir/Makefile.PL";
34
35 # typo?
36 $cmop_dep = '0.64_07' if $cmop_dep eq '0.6407';
37
38 # nonexistent dev releases?
39 $cmop_dep = '0.79' if $cmop_dep eq '0.78_02';
40 $cmop_dep = '0.83' if $cmop_dep eq '0.82_01';
41
42 bump_cmop($cmop_dep, $moose);
43
44 warn "Building $moose_dir";
45 eval {
46 system("(cd '$moose_dir' && '$^X' '-I$cmop_dir/lib' Makefile.PL && make && sudo make install) >/dev/null");
47
48 my @times;
49 for (1 .. 5) {
50 my $start = time;
51 system(
52 $^X,
53 "-I$moose_dir/lib",
54 "-I$cmop_dir/lib",
55 '-e', 'package Class; use Moose;',
56 );
57 push @times, time - $start;
58 }
59
ee16bf2b 60 $time{$moose->version} = sum(@times) / @times;
61 $mem{$moose->version} = qx[$^X -I$moose_dir/lib -I$cmop_dir/lib -MGTop -e 'my (\$gtop, \$before); BEGIN { \$gtop = GTop->new; \$before = \$gtop->proc_mem(\$\$)->size; } package Class; use Moose; print \$gtop->proc_mem(\$\$)->size - \$before'];
62 my $line = sprintf "%7s: %0.4f (%s), %d bytes\n",
5ee2a036 63 $moose->version,
ee16bf2b 64 $time{$moose->version},
5ee2a036 65 join(', ', map { sprintf "%0.4f", $_ } @times),
ee16bf2b 66 $mem{$moose->version};
67 print $output $line;
5ee2a036 68 };
69 warn $@ if $@;
70}
71
ee16bf2b 72require Chart::Clicker;
73require Chart::Clicker::Data::Series;
74require Chart::Clicker::Data::DataSet;
75my @versions = sort keys %time;
76my @startups = map { $time{$_} } @versions;
77my @memories = map { int($mem{$_} / 1024) } @versions;
78my @keys = (0..$#versions);
79my $cc = Chart::Clicker->new(width => 900, height => 400);
80my $sutime = Chart::Clicker::Data::Series->new(
81 values => \@startups,
82 keys => \@keys,
83 name => 'Startup Time',
84);
85my $def = $cc->get_context('default');
86$def->domain_axis->tick_values(\@keys);
87$def->domain_axis->tick_labels(\@versions);
88$def->domain_axis->tick_label_angle(1.57);
89$def->domain_axis->tick_font->size(8);
90$def->range_axis->fudge_amount('0.05');
91
92my $context = Chart::Clicker::Context->new(name => 'memory');
93$context->range_axis->tick_values([qw(1024 2048 3072 4096 5120)]);
94$context->range_axis->format('%d');
95$context->domain_axis->hidden(1);
96$context->range_axis->fudge_amount('0.05');
97$cc->add_to_contexts($context);
98
99my $musage = Chart::Clicker::Data::Series->new(
100 values => \@memories,
101 keys => \@keys,
102 name => 'Memory Usage (kb)'
103);
104
105my $ds1 = Chart::Clicker::Data::DataSet->new(series => [ $sutime ]);
106my $ds2 = Chart::Clicker::Data::DataSet->new(series => [ $musage ]);
107$ds2->context('memory');
108
109$cc->add_to_datasets($ds1);
110$cc->add_to_datasets($ds2);
111$cc->write_output('moose_bench.png');
112
5ee2a036 113sub bump_cmop {
114 my $expected = shift;
115 my $moose = shift;
116
117 return $cmop_dir if $cmop_version eq $expected;
118
119 my @orig_cmops = @cmops;
120 shift @cmops until !@cmops || $cmops[0]->version eq $expected;
121
122 die "Ran out of cmops, wanted $expected for "
123 . $moose->distvname
124 . " (had " . join(', ', map { $_->version } @orig_cmops) . ")"
125 if !@cmops;
126
127 $cmop_version = $cmops[0]->version;
128 $cmop_dir = build($cmops[0]);
129
130 warn "Building $cmop_dir";
131 system("(cd '$cmop_dir' && '$^X' Makefile.PL && make && sudo make install) >/dev/null");
132
133 return $cmop_dir;
134}
135
136sub build {
137 my $dist = shift;
138 my $distvname = $dist->distvname;
139 return $distvname if -d $distvname;
140
141 warn "Downloading $distvname";
142 my $tarball = get($base . $dist->prefix);
143 open my $handle, '<', \$tarball;
144
145 my $tar = Archive::Tar->new;
146 $tar->read($handle);
147 $tar->extract;
148
149 my ($arbitrary_file) = $tar->list_files;
150 (my $directory = $arbitrary_file) =~ s{/.*}{};
151 return $directory;
152}
153