File Coverage

inc/My/Build.pm
Criterion Covered Total %
statement 33 65 50.7
branch 5 8 62.5
condition n/a
subroutine 7 16 43.7
pod 0 10 0.0
total 45 99 45.4


line stmt bran cond sub pod time code
1             ########################################################################
2             package My::Build;
3             ########################################################################
4              
5 1     1   13831 use strict;
  1         1  
  1         35  
6 1     1   5 use warnings;
  1         3  
  1         45  
7 1     1   545 use parent 'Module::Build';
  1         304  
  1         5  
8              
9             sub ACTION_build {
10 0     0 0 0 my $self = shift;
11            
12 0         0 mkdir 'share';
13            
14 0         0 $self->SUPER::ACTION_build;
15             }
16              
17 1     1   78943 use File::Path;
  1         2  
  1         181  
18             sub ACTION_clean {
19 0     0 0 0 my $self = shift;
20            
21 0         0 File::Path::remove_tree('share');
22 0         0 $self->notes('build_state', '');
23            
24             # Call system-specific cleanup code
25 0         0 $self->my_clean;
26            
27             # Call base class code
28 0         0 $self->SUPER::ACTION_clean;
29             }
30              
31 1     1   5 use File::Copy;
  1         1  
  1         53  
32 1     1   4 use File::Spec;
  1         2  
  1         362  
33             sub ACTION_devsetup {
34 0     0 0 0 my $self = shift;
35 0         0 system qw(git submodule init);
36 0         0 system qw(git submodule update);
37 0         0 my $hook_filename = File::Spec->catfile(qw<.git hooks pre-commit>);
38 0         0 copy 'git-pre-commit-hook.pl' => $hook_filename;
39 0         0 chmod 0755, $hook_filename;
40             }
41              
42             # Reset the tcc source code. This only makes sense if the person has
43             # src checked out as a git submodule, but then again, the actions for
44             # which this exists are generally considered author actions anyway.
45             sub reset_src {
46 0     0 0 0 chdir 'src';
47 0         0 system qw( git reset --hard HEAD );
48 0         0 chdir '..';
49             }
50              
51             sub ACTION_devclean {
52 0     0 0 0 my $self = shift;
53 0         0 reset_src;
54 0         0 $self->ACTION_clean;
55             }
56              
57             sub ACTION_devrealclean {
58 0     0 0 0 my $self = shift;
59 0         0 reset_src;
60 0         0 $self->ACTION_realclean;
61             }
62              
63             # This one's an author action, so I assume they have git and have properly
64             # configured.
65             sub ACTION_dist {
66 0     0 0 0 my $self = shift;
67 0         0 reset_src;
68 0         0 $self->SUPER::ACTION_dist;
69             }
70              
71             # This one's an author action, so I assume they have git and have properly
72             # configured.
73             sub ACTION_distdir {
74 0     0 0 0 my $self = shift;
75 0         0 reset_src;
76 0         0 $self->SUPER::ACTION_distdir;
77             }
78              
79             # This one's an author action, so I assume they have git and have properly
80             # configured.
81             sub ACTION_disttest {
82 0     0 0 0 my $self = shift;
83 0         0 reset_src;
84 0         0 $self->SUPER::ACTION_disttest;
85             }
86              
87             sub apply_patches {
88 52     52 0 601197 my ($filename, @patches) = @_;
89            
90             # make the file read-write (and executable, but that doesn't matter)
91 52         2416 chmod 0700, $filename;
92            
93 52 50       2252 open my $in_fh, '<', $filename
94             or die "Unable to open $filename for patching!";
95 52 50       5905 open my $out_fh, '>', "$filename.new"
96             or die "Unable to open $filename.new for patching!";
97 52         760 LINE: while (my $line = <$in_fh>) {
98             # Apply each basic test regex, and call the function if it matches
99 1716         3071 for (my $i = 0; $i < @patches; $i += 2) {
100 3432 100       15561 if ($line =~ $patches[$i]) {
101 52         430 my $next_line = $patches[$i+1]->($in_fh, $out_fh, $line);
102 52 50       991 next LINE if $next_line;
103             }
104             }
105 1716         4865 print $out_fh $line;
106             }
107            
108 52         444 close $in_fh;
109 52         2891 close $out_fh;
110 52         6488 unlink $filename;
111 52         3132 rename "$filename.new" => $filename;
112            
113             # make sure it's executable; we may be patching ./configure
114 52         1364 chmod 0700, $filename;
115             }
116              
117             1;