From: gfx <gfuji@cpan.org>
Date: Wed, 15 Jul 2009 06:13:52 +0000 (+0900)
Subject: Improve profiling script. Type "perl bench/profile.pl" and nytprof-$branch will be... 
X-Git-Tag: 0.90~20
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=26b2e5ab09bdd030faa1c8fc53066c6adfa22f09;hp=6f219abc79a2306a84bf335245ebbdf33cf9c107;p=gitmo%2FClass-MOP.git

Improve profiling script. Type "perl bench/profile.pl" and nytprof-$branch will be created.
---

diff --git a/bench/foo.pl b/bench/foo.pl
new file mode 100755
index 0000000..a2c799a
--- /dev/null
+++ b/bench/foo.pl
@@ -0,0 +1,66 @@
+#!perl
+# a moose using script for profiling
+# Usage: perl bench/profile.pl
+
+package Foo;
+use Moose;
+
+has aaa => (
+	is => 'rw',
+	isa => 'Str',
+);
+
+has bbb => (
+	is => 'rw',
+	isa => 'Str',
+);
+
+has ccc => (
+	is => 'rw',
+	isa => 'Str',
+);
+
+has ddd => (
+	is => 'rw',
+	isa => 'Str',
+);
+
+has eee => (
+	is => 'rw',
+	isa => 'Str',
+);
+
+__PACKAGE__->meta->make_immutable();
+
+
+package Bar;
+use Moose;
+
+extends 'Foo';
+
+has xaaa => (
+	is => 'rw',
+	isa => 'Str',
+);
+
+has xbbb => (
+	is => 'rw',
+	isa => 'Str',
+);
+
+has xccc => (
+	is => 'rw',
+	isa => 'Str',
+);
+
+has xddd => (
+	is => 'rw',
+	isa => 'Str',
+);
+
+has xeee => (
+	is => 'rw',
+	isa => 'Str',
+);
+
+__PACKAGE__->meta->make_immutable();
diff --git a/bench/loading-profile.pl b/bench/loading-profile.pl
deleted file mode 100755
index 5337d84..0000000
--- a/bench/loading-profile.pl
+++ /dev/null
@@ -1,2 +0,0 @@
-#!perl -wd:NYTProf
-require Moose;
diff --git a/bench/profile.pl b/bench/profile.pl
new file mode 100755
index 0000000..c4ffc6f
--- /dev/null
+++ b/bench/profile.pl
@@ -0,0 +1,25 @@
+#!perl -w
+# Usage: perl bench/profile.pl (no other options including -Mblib are reqired)
+
+use strict;
+
+my $script = 'bench/foo.pl';
+
+my $branch = do{
+	open my $in, '.git/HEAD' or die "Cannot open .git/HEAD: $!";
+	my $s = scalar <$in>;
+	chomp $s;
+	$s =~ s{^ref: \s+ refs/heads/}{}xms;
+	$s =~ s{/}{_}xmsg;
+	$s;
+};
+
+print "Profiling $branch ...\n";
+
+my @cmd = ($^X, '-Iblib/lib', '-Iblib/arch', $script);
+print "> @cmd\n";
+system(@cmd) == 0 or die "Cannot profile";
+
+@cmd = ($^X, '-S', 'nytprofhtml', '--out', "nytprof-$branch");
+print "> @cmd\n";
+system(@cmd) == 0 or die "Cannot profile";