Skip to content
This repository
Browse code

Improve parallelism for cpancover.

Better locking and ignoring of certain errors.
  • Loading branch information...
commit a750db77071cf46db3bb602f44180906edb38bba 1 parent 18eebb8
Paul Johnson authored October 07, 2012
81  bin/cpancover
@@ -18,6 +18,7 @@ use Devel::Cover::DB;
18 18
 use Devel::Cover::Dumper;
19 19
 
20 20
 use Cwd ();
  21
+use Fcntl ":flock";
21 22
 use Getopt::Long;
22 23
 use Pod::Usage;
23 24
 use Template 2.00;
@@ -88,15 +89,19 @@ sub read_results
88 89
     my $f = "$Options->{outputdir}/cover.results";
89 90
     my %results;
90 91
 
91  
-    if (open S, "<", $f)
  92
+    open my $fh, "<", $f or return;
  93
+    my $try;
  94
+    until (flock $fh, LOCK_SH)
92 95
     {
93  
-        while (<S>)
94  
-        {
95  
-            my ($mod, $status) = split;
96  
-            $results{$mod} = $status;
97  
-        }
98  
-        close S or die "Can't close $f: $!\n";
  96
+        die "Can't lock $f: $!\n" if $try++ > 60;
  97
+        sleep 1;
  98
+    }
  99
+    while (<$fh>)
  100
+    {
  101
+        my ($mod, $status) = split;
  102
+        $results{$mod} = $status;
99 103
     }
  104
+    close $fh or die "Can't close $f: $!\n";
100 105
 
101 106
     \%results
102 107
 }
@@ -150,12 +155,18 @@ sub get_cover
150 155
 
151 156
     $results->{$module} = 1;
152 157
 
153  
-    open S, ">", $f or die "Can't open $f: $!\n";
  158
+    open my $fh, ">", $f or die "Can't open $f: $!\n";
  159
+    my $try;
  160
+    until (flock $fh, LOCK_EX)
  161
+    {
  162
+        die "Can't lock $f: $!\n" if $try++ > 60;
  163
+        sleep 1;
  164
+    }
154 165
     for my $mod (sort keys %$results)
155 166
     {
156  
-        print S "$mod $results->{$mod}\n";
  167
+        print $fh "$mod $results->{$mod}\n";
157 168
     }
158  
-    close S or die "Can't close $f: $!\n";
  169
+    close $fh or die "Can't close $f: $!\n";
159 170
 
160 171
     sys "cat $out" if -e $out;
161 172
 }
@@ -292,29 +303,32 @@ sub write_html
292 303
         chdir "$Options->{directory}/$module";
293 304
         print "Adding $module from $dbdir\n";
294 305
 
295  
-        my $db = Devel::Cover::DB->new(db => $dbdir);
296  
-        # next unless $db->is_valid;
297  
-
298  
-        my $criteria = $vars->{criteria} ||=
299  
-                       [ grep(!/path|time/, $db->all_criteria) ];
300  
-        $vars->{headers} ||=
301  
-                       [ grep(!/path|time/, $db->all_criteria_short) ];
302  
-
303  
-        my %options = map { $_ => 1 } @$criteria;
304  
-        $db->calculate_summary(%options);
305  
-
306  
-        push @{$vars->{modules}}, $module;
307  
-        $vals{$module}{link} = "$module/$Options->{outputfile}";
308  
-
309  
-        for my $criterion (@$criteria)
  306
+        eval
310 307
         {
311  
-            my $summary = $db->summary("Total", $criterion);
312  
-            my $pc = $summary->{percentage};
313  
-            $pc = defined $pc ? sprintf "%6.2f", $pc : "n/a";
314  
-            $vals{$module}{$criterion}{pc}      = $pc;
315  
-            $vals{$module}{$criterion}{class}   = class($pc);
316  
-            $vals{$module}{$criterion}{details} =
317  
-                ($summary->{covered} || 0) . " / " . ($summary->{total} || 0);
  308
+            my $db = Devel::Cover::DB->new(db => $dbdir);
  309
+            # next unless $db->is_valid;
  310
+
  311
+            my $criteria = $vars->{criteria} ||=
  312
+                           [ grep(!/path|time/, $db->all_criteria) ];
  313
+            $vars->{headers} ||=
  314
+                           [ grep(!/path|time/, $db->all_criteria_short) ];
  315
+
  316
+            my %options = map { $_ => 1 } @$criteria;
  317
+            $db->calculate_summary(%options);
  318
+
  319
+            push @{$vars->{modules}}, $module;
  320
+            $vals{$module}{link} = "$module/$Options->{outputfile}";
  321
+
  322
+            for my $criterion (@$criteria)
  323
+            {
  324
+                my $summary = $db->summary("Total", $criterion);
  325
+                my $pc = $summary->{percentage};
  326
+                $pc = defined $pc ? sprintf "%6.2f", $pc : "n/a";
  327
+                $vals{$module}{$criterion}{pc}      = $pc;
  328
+                $vals{$module}{$criterion}{class}   = class($pc);
  329
+                $vals{$module}{$criterion}{details} =
  330
+                  ($summary->{covered} || 0) . " / " . ($summary->{total} || 0);
  331
+            }
318 332
         }
319 333
     }
320 334
 
@@ -343,7 +357,8 @@ sub main
343 357
         my @res = iterate_as_array
344 358
         (
345 359
             { workers => $workers },
346  
-            sub { get_cover $_[1] },
  360
+            sub { eval { get_cover $_[1] };
  361
+                  warn "\n\n\n[$_[1]]: $@\n\n\n" if $@ },
347 362
             $Options->{module}
348 363
         );
349 364
         # print Dumper \@res;
22  lib/Devel/Cover/DB/IO/JSON.pm
@@ -35,13 +35,17 @@ sub read
35 35
     my $self   = shift;
36 36
     my ($file) = @_;
37 37
 
38  
-    open my $fh, "<", $file or die "Can't open $file: $!";
39  
-    flock($fh, LOCK_SH) or die "Cannot lock file: $!\n";
  38
+    open my $fh, "<", $file or die "Can't open $file: $!\n";
  39
+    flock $fh, LOCK_SH      or die "Can't lock $file: $!\n";
40 40
     local $/;
41  
-    my $data = $Format eq "JSON"
42  
-        ? JSON::decode_json(<$fh>)
43  
-        : JSON::PP::decode_json(<$fh>);
44  
-    close $fh or die "Can't close $file: $!";
  41
+    my $data;
  42
+    eval {
  43
+        $data = $Format eq "JSON"
  44
+            ? JSON::decode_json(<$fh>)
  45
+            : JSON::PP::decode_json(<$fh>);
  46
+    };
  47
+    die "Can't read $file with $Format: $@" if $@;
  48
+    close $fh or die "Can't close $file: $!\n";
45 49
     $data
46 50
 }
47 51
 
@@ -53,10 +57,10 @@ sub write
53 57
     my $json = $Format eq "JSON" ? JSON->new : JSON::PP->new;
54 58
     $json->utf8->allow_blessed;
55 59
     $json->ascii->pretty->canonical if $self->{options} =~ /\bpretty\b/i;
56  
-    open my $fh, ">", $file or die "Can't open $file: $!";
57  
-    flock($fh, LOCK_EX) or die "Cannot lock file: $!\n";
  60
+    open my $fh, ">", $file or die "Can't open $file: $!\n";
  61
+    flock $fh, LOCK_EX      or die "Can't lock $file: $!\n";
58 62
     print $fh $json->encode($data);
59  
-    close $fh or die "Can't close $file: $!";
  63
+    close $fh or die "Can't close $file: $!\n";
60 64
     $self
61 65
 }
62 66
 

0 notes on commit a750db7

Please sign in to comment.
Something went wrong with that request. Please try again.