File Coverage

blib/lib/Benchmark/Report/GitHub.pm
Criterion Covered Total %
statement 9 75 12.0
branch 0 10 0.0
condition 0 18 0.0
subroutine 3 7 42.8
pod 4 4 100.0
total 16 114 14.0


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__