File Coverage

blib/lib/App/Rakubrew/Build.pm
Criterion Covered Total %
statement 26 172 15.1
branch 0 58 0.0
condition 0 28 0.0
subroutine 9 22 40.9
pod 0 5 0.0
total 35 285 12.2


line stmt bran cond sub pod time code
1             package App::Rakubrew::Build;
2             require Exporter;
3             our @ISA = qw(Exporter);
4             our @EXPORT = qw();
5              
6 3     3   21 use strict;
  3         6  
  3         82  
7 3     3   16 use warnings;
  3         5  
  3         76  
8 3     3   48 use 5.010;
  3         10  
9 3     3   17 use File::Spec::Functions qw(catdir catfile updir);
  3         5  
  3         189  
10 3     3   1986 use IPC::Cmd qw(can_run);
  3         181169  
  3         224  
11 3     3   40 use Cwd qw(cwd);
  3         7  
  3         143  
12 3     3   1070 use App::Rakubrew::Variables;
  3         5  
  3         519  
13 3     3   900 use App::Rakubrew::Tools;
  3         6  
  3         199  
14 3     3   1031 use App::Rakubrew::VersionHandling;
  3         6  
  3         5754  
15              
16             sub _version_is_at_least {
17 0     0     my $min_ver = shift;
18 0           my $rakudo_dir = shift;
19 0           my $ver = slurp(catfile($rakudo_dir, 'VERSION'));
20 0           my ($min_year, $min_month, $min_sub);
21 0           my ($year, $month, $sub);
22 0 0         if ($ver =~ /(\d\d\d\d)\.(\d\d)(?:\.(\d+))?/ ) {
23 0           $year = $1;
24 0           $month = $2;
25 0   0       $sub = $3 // 0;
26             }
27 0 0         if ($min_ver =~ /(\d\d\d\d)\.(\d\d)(?:\.(\d+))?/ ) {
28 0           $min_year = $1;
29 0           $min_month = $2;
30 0   0       $min_sub = $3 // 0;
31             }
32              
33             # If it's not a release by date, it's older.
34 0 0 0       return 1 if !$min_year && $year;
35 0 0 0       return 0 if $min_year && !$year;
36              
37             # If both are really old not by date releases, we are conservative and say
38             # the release is older hopefully backwards compatibility will save us.
39 0 0 0       return 0 if !$min_year && !$year;
40              
41 0 0         return 1 if $min_year < $year;
42 0 0         return 0 if $min_year > $year;
43 0 0         return 1 if $min_month < $month;
44 0 0         return 0 if $min_month > $month;
45 0 0         return 1 if $min_sub < $sub;
46 0 0         return 0 if $min_sub > $sub;
47              
48 0           return 1; # $min_sub == $sub;
49             }
50              
51             sub _get_git_cache_option {
52 0     0     my $rakudo_dir = shift;
53 0 0         if ( _version_is_at_least('2020.02', $rakudo_dir) ) {
54 0           return "--git-cache-dir=\"$git_reference\"";
55             }
56             else {
57 0           return "--git-reference=\"$git_reference\"";
58             }
59             }
60              
61             sub _get_relocatable_option {
62 0     0     my $rakudo_dir = shift;
63 0 0         if ( _version_is_at_least('2019.07', $rakudo_dir) ) {
64 0           return "--relocatable";
65             }
66 0           say STDERR "The current rakubrew setup requires Rakudo to be relocated, but the";
67 0           say STDERR "Rakudo you selected to be built does not support the `--relocatable`";
68 0           say STDERR "option yet. Try building a newer Rakudo.";
69 0           exit 1;
70             }
71              
72             sub available_rakudos {
73 0     0 0   _check_git();
74              
75 0           my @output = qx|$GIT ls-remote --tags $git_repos{rakudo}|;
76 0           my @tags = grep(m{refs/tags/([^\^]+)\^\{\}}, @output);
77 0           @tags = map(m{tags/([^\^]+)\^}, @tags);
78 0           @tags = grep(/^\d/, @tags);
79 0           return sort(@tags), 'main';
80             }
81              
82             sub build_impl {
83 0     0 0   my ($impl, $ver, $configure_opts) = @_;
84              
85 0           _check_build_dependencies();
86              
87 0           my $name = "$impl-$ver";
88 0 0 0       $name = $impl if $impl eq 'moar-blead' && $ver eq 'main';
89              
90 0 0 0       if (version_exists($name) && is_registered_version($name)) {
91 0           say STDERR "$name is a registered version. I'm not going to touch it.";
92 0           exit 1;
93             }
94              
95 0           chdir $versions_dir;
96 0 0         unless (version_exists($name)) {
97 0           for(@{$impls{$impl}{need_repo}}) {
  0            
98 0           _update_git_reference($_);
99             }
100 0           run "$GIT clone --reference \"$git_reference/rakudo\" $git_repos{rakudo} $name";
101             }
102 0           chdir $name;
103 0           run "$GIT fetch";
104             # when people say 'build somebranch', they usually mean 'build origin/somebranch'
105 0           my $ver_to_checkout = $ver;
106 0           eval {
107 0           run "$GIT rev-parse -q --verify origin/$ver";
108 0           $ver_to_checkout = "origin/$ver";
109             };
110 0           run "$GIT checkout -q $ver_to_checkout";
111              
112 0           $configure_opts .= ' ' . _get_git_cache_option(cwd());
113 0           run $impls{$impl}{configure} . " $configure_opts";
114             }
115              
116             sub determine_make {
117 0     0 0   my $version = shift;
118              
119 0           my $cmd = get_raku($version) . ' --show-config';
120 0           my $config = qx{$cmd};
121              
122 0           my $make;
123 0 0         $make = $1 if $config =~ m/::make=(.*)$/m;
124              
125 0 0         if (!$make) {
126 0           say STDERR "Couldn't determine correct make program. Aborting.";
127 0           exit 1;
128             }
129              
130 0           return $make;
131             }
132              
133             sub build_triple {
134 0     0 0   my ($rakudo_ver, $nqp_ver, $moar_ver) = @_;
135              
136 0           _check_build_dependencies();
137              
138 0           my $impl = "moar";
139 0   0       $rakudo_ver //= 'HEAD';
140 0   0       $nqp_ver //= 'HEAD';
141 0   0       $moar_ver //= 'HEAD';
142              
143 0           my $name = "$impl-$rakudo_ver-$nqp_ver-$moar_ver";
144              
145 0           chdir $versions_dir;
146              
147 0 0         unless (-d $name) {
148 0           _update_git_reference('rakudo');
149 0           run "$GIT clone --reference \"$git_reference/rakudo\" $git_repos{rakudo} $name";
150             }
151 0           chdir $name;
152 0           run "$GIT pull";
153 0           run "$GIT checkout $rakudo_ver";
154              
155 0           my $configure_opts = '--make-install'
156             . ' --prefix=' . catdir($versions_dir, $name, 'install')
157             . ' ' . _get_git_cache_option(cwd());
158              
159 0 0         unless (-d "nqp") {
160 0           _update_git_reference('nqp');
161 0           run "$GIT clone --reference \"$git_reference/nqp\" $git_repos{nqp}";
162             }
163 0           chdir "nqp";
164 0           run "$GIT pull";
165 0           run "$GIT checkout $nqp_ver";
166              
167 0 0         unless (-d "MoarVM") {
168 0           _update_git_reference('MoarVM');
169 0           run "$GIT clone --reference \"$git_reference/MoarVM\" $git_repos{MoarVM}";
170             }
171              
172 0           chdir "MoarVM";
173 0           run "$GIT pull";
174 0           run "$GIT checkout $moar_ver";
175              
176 0           run "$PERL5 Configure.pl " . $configure_opts;
177              
178 0           chdir updir();
179 0           run "$PERL5 Configure.pl --backend=moar " . $configure_opts;
180              
181 0           chdir updir();
182 0           run "$PERL5 Configure.pl --backend=moar " . $configure_opts;
183              
184 0 0         if (-d 'zef') {
185 0           say "Updating zef as well";
186 0           build_zef($name);
187             }
188              
189 0           return $name;
190             }
191              
192             sub _verify_git_branch_exists {
193 0     0     my $branch = shift;
194 0           return system("$GIT show-ref --verify -q refs/heads/" . $branch) == 0;
195             }
196              
197             sub build_zef {
198 0     0 0   my $version = shift;
199 0           my $zef_version = shift;
200              
201 0           _check_git();
202              
203 0 0         if (-d $zef_dir) {
204 0           chdir $zef_dir;
205 0 0         if (!_verify_git_branch_exists('main')) {
206 0           run "$GIT fetch -q origin main";
207             }
208 0           run "$GIT checkout -f -q main && git reset --hard HEAD && $GIT pull -q";
209             } else {
210 0           run "$GIT clone $git_repos{zef} $zef_dir";
211 0           chdir $zef_dir;
212             }
213              
214 0           my %tags = map { chomp($_); $_ => 1 } `$GIT tag`;
  0            
  0            
215 0 0 0       if ( $zef_version && !$tags{$zef_version} ) {
216 0           die "Couldn't find version $zef_version, aborting\n";
217             }
218              
219 0 0         if ( $zef_version ) {
220 0           run "$GIT checkout tags/$zef_version";
221             } else {
222 0           run "$GIT checkout main";
223             }
224 0           run get_raku($version) . " -I. bin/zef test .";
225 0           run get_raku($version) . " -I. bin/zef --/test --force install .";
226             }
227              
228             sub _update_git_reference {
229 0     0     my $repo = shift;
230 0           my $back = cwd();
231 0           print "Update git reference: $repo\n";
232 0           chdir $git_reference;
233 0 0         unless (-d $repo) {
234 0           run "$GIT clone --bare $git_repos{$repo} $repo";
235             }
236 0           chdir $repo;
237 0           run "$GIT fetch";
238 0           chdir $back;
239             }
240              
241             sub _check_build_dependencies() {
242 0     0     _check_git();
243 0           _check_perl();
244             }
245              
246             sub _check_git {
247 0 0   0     if (!can_run($GIT)) {
248 0           say STDERR "Did not find `$GIT` program. That's a requirement for using some rakubrew commmands. Aborting.";
249 0           exit 1;
250             }
251             }
252              
253             sub _check_perl {
254 0 0   0     if (!can_run($PERL5)) {
255 0           say STDERR "Did not find `$PERL5` program. That's a requirement for using some rakubrew commands. Aborting.";
256 0           exit 1;
257             }
258             }
259              
260             1;
261