line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
1
|
|
|
1
|
|
17957
|
use 5.006; |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
68
|
|
2
|
1
|
|
|
1
|
|
8
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
49
|
|
3
|
1
|
|
|
1
|
|
7
|
use warnings; |
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
1505
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
package Benchmark::Report::GitHub; |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:TOBYINK'; |
8
|
|
|
|
|
|
|
our $VERSION = '0.002'; |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
my @attributes = qw/ travis_repo_slug gh_name gh_email gh_token /; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
sub new { |
13
|
0
|
|
|
0
|
1
|
|
my $class = shift; |
14
|
0
|
|
|
|
|
|
my $self = bless +{ @_ }, $class; |
15
|
|
|
|
|
|
|
defined($self->{$_}) || die("missing required attribute: $_") |
16
|
0
|
|
0
|
|
|
|
for @attributes; |
17
|
0
|
|
|
|
|
|
return $self; |
18
|
|
|
|
|
|
|
} |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub new_from_env { |
21
|
0
|
|
|
0
|
1
|
|
my $class = shift; |
22
|
|
|
|
|
|
|
|
23
|
0
|
|
|
|
|
|
my $missing = 0; |
24
|
0
|
|
|
|
|
|
for my $var (qw/ TRAVIS_REPO_SLUG GH_NAME GH_EMAIL GH_TOKEN /) { |
25
|
0
|
0
|
|
|
|
|
next if defined $ENV{$var}; |
26
|
0
|
|
|
|
|
|
warn "missing: $var\n"; |
27
|
0
|
|
|
|
|
|
$missing++; |
28
|
|
|
|
|
|
|
} |
29
|
0
|
0
|
|
|
|
|
die "correct environment variables are not set; bailing out" |
30
|
|
|
|
|
|
|
if $missing; |
31
|
|
|
|
|
|
|
|
32
|
0
|
|
|
|
|
|
$class->new(map +( $_ => $ENV{uc($_)} ), @attributes); |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
sub add_benchmark { |
36
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
37
|
0
|
0
|
|
|
|
|
@_ == 3 or die("too many or too few arguments"); |
38
|
0
|
|
0
|
|
|
|
push @{ $self->{benchmarks} ||= [] }, @_; |
|
0
|
|
|
|
|
|
|
39
|
0
|
|
|
|
|
|
return $self; |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
sub publish { |
43
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
44
|
0
|
|
|
|
|
|
my %args = @_; |
45
|
|
|
|
|
|
|
|
46
|
0
|
|
|
|
|
|
my ($owner, $project) = split "/", $self->{travis_repo_slug}; |
47
|
|
|
|
|
|
|
|
48
|
0
|
0
|
|
|
|
|
my @benchmarks = @{$self->{benchmarks}} |
|
0
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
or die "did you forget something?"; |
50
|
|
|
|
|
|
|
|
51
|
0
|
|
|
|
|
|
system("rm -fr $project.wiki"); |
52
|
0
|
|
|
|
|
|
system("git clone https://github.com/$owner/$project.wiki.git"); |
53
|
|
|
|
|
|
|
|
54
|
0
|
|
0
|
|
|
|
my $perl = $args{perl_version} || $ENV{TRAVIS_PERL_VERSION} || $]; |
55
|
0
|
0
|
0
|
|
|
|
my ($build_num, $build_id, $job_num, $job_id) = map { |
56
|
0
|
|
|
|
|
|
$args{$_} || $ENV{ "TRAVIS_" . uc($_) } || 'unknown' |
57
|
|
|
|
|
|
|
} qw( build_number build_id job_number job_id ); |
58
|
|
|
|
|
|
|
|
59
|
0
|
|
0
|
|
|
|
my $page = $args{page} || "Benchmark_$job_id"; |
60
|
0
|
|
0
|
|
|
|
my $title = $args{page_title} || "Travis Job $job_num"; |
61
|
0
|
|
0
|
|
|
|
my $idxpage = $args{index_page} || "Benchmarks"; |
62
|
|
|
|
|
|
|
|
63
|
0
|
|
|
|
|
|
require Benchmark; |
64
|
0
|
|
|
|
|
|
require Cwd; |
65
|
0
|
|
|
|
|
|
require File::Path; |
66
|
|
|
|
|
|
|
|
67
|
0
|
|
|
|
|
|
RESULTS: { |
68
|
0
|
|
|
|
|
|
open my $fh, ">", "$project.wiki/$page.md"; |
69
|
0
|
|
|
|
|
|
print $fh "# $title\n\n"; |
70
|
0
|
|
|
|
|
|
print $fh "[Build log](https://travis-ci.org/$owner/$project/jobs/$job_id).\n\n"; |
71
|
0
|
|
|
|
|
|
my $old = select($fh); |
72
|
0
|
|
|
|
|
|
while (@benchmarks) { |
73
|
0
|
|
|
|
|
|
my ($name, $times, $cases) = splice(@benchmarks, 0, 3); |
74
|
0
|
|
|
|
|
|
print "## $name\n\n"; |
75
|
0
|
|
|
|
|
|
print "```\n"; |
76
|
0
|
|
|
|
|
|
Benchmark::cmpthese($times, $cases); |
77
|
0
|
|
|
|
|
|
print "```\n\n"; |
78
|
|
|
|
|
|
|
} |
79
|
0
|
|
|
|
|
|
select($old); |
80
|
0
|
|
|
|
|
|
close $fh; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
INDEX: { |
84
|
0
|
|
|
|
|
|
open my $idx, ">>", "$project.wiki/$idxpage.md"; |
|
0
|
|
|
|
|
|
|
85
|
0
|
|
|
|
|
|
print $idx "* [$title]($page)\n"; |
86
|
0
|
|
|
|
|
|
close $idx; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
UPLOAD: { |
90
|
0
|
|
|
|
|
|
my $orig = Cwd::cwd(); |
|
0
|
|
|
|
|
|
|
91
|
0
|
|
|
|
|
|
chdir "$project.wiki"; |
92
|
0
|
|
|
|
|
|
system("git config user.name '$ENV{GH_NAME}'"); |
93
|
0
|
|
|
|
|
|
system("git config user.email '$ENV{GH_EMAIL}'"); |
94
|
0
|
|
|
|
|
|
system("git config credential.helper 'store --file=.git/credentials'"); |
95
|
0
|
|
|
|
|
|
open my $cred, '>', '.git/credentials'; |
96
|
0
|
|
|
|
|
|
print $cred "https://$ENV{GH_TOKEN}:\@github.com\n"; |
97
|
0
|
|
|
|
|
|
close $cred; |
98
|
0
|
|
|
|
|
|
system("git add ."); |
99
|
0
|
|
|
|
|
|
system("git commit -a -m 'benchmarks for $job_num'"); |
100
|
0
|
|
|
|
|
|
system("git push --all"); |
101
|
0
|
|
|
|
|
|
system("rm '.git/credentials'"); |
102
|
0
|
|
|
|
|
|
chdir($orig); |
103
|
0
|
|
|
|
|
|
File::Path::remove_tree("$project.wiki"); |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
0
|
|
|
|
|
|
return "https://github.com/$owner/$project/wiki/$page"; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
1; |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
__END__ |