File Coverage

blib/lib/SPVM/Builder/Util.pm
Criterion Covered Total %
statement 298 355 83.9
branch 60 110 54.5
condition 5 9 55.5
subroutine 44 51 86.2
pod 0 36 0.0
total 407 561 72.5


line stmt bran cond sub pod time code
1             package SPVM::Builder::Util;
2              
3 283     283   235311 use strict;
  283         792  
  283         9148  
4 283     283   1838 use warnings;
  283         865  
  283         7714  
5 283     283   1673 use Carp 'confess';
  283         786  
  283         14902  
6 283     283   14702 use Config;
  283         1083  
  283         10835  
7 283     283   1823 use File::Path 'mkpath';
  283         678  
  283         13094  
8 283     283   173093 use Pod::Usage 'pod2usage';
  283         14564119  
  283         29329  
9 283     283   246735 use Getopt::Long 'GetOptionsFromArray';
  283         3108586  
  283         1605  
10 283     283   57754 use List::Util 'min';
  283         788  
  283         34006  
11 283     283   2533 use File::Basename 'dirname';
  283         723  
  283         12429  
12 283     283   1978 use File::Spec;
  283         776  
  283         6126  
13 283     283   174372 use SPVM::Builder::Config;
  283         3646  
  283         12543  
14 283     283   2117 use Encode 'decode';
  283         3529  
  283         19167  
15 283     283   1999 use File::Find 'find';
  283         3159  
  283         1254215  
16              
17             # SPVM::Builder::Util is used from Makefile.PL
18             # so this class must be wrote as pure perl script, not contain XS functions.
19              
20             sub get_spvm_core_perl_class_file_names {
21 1110     1110 0 22713 my @spvm_builder_class_file_names = qw(
22             SPVM/BlessedObject/Array.pm
23             SPVM/BlessedObject/Class.pm
24             SPVM/BlessedObject.pm
25             SPVM/BlessedObject/String.pm
26             SPVM/Builder/API.pm
27             SPVM/Builder/CC.pm
28             SPVM/Builder/CompileInfo.pm
29             SPVM/Builder/Compiler.pm
30             SPVM/Builder/Config/Exe.pm
31             SPVM/Builder/Config.pm
32             SPVM/Builder/Env.pm
33             SPVM/Builder/Exe.pm
34             SPVM/Builder/LibInfo.pm
35             SPVM/Builder/LinkInfo.pm
36             SPVM/Builder/ObjectFileInfo.pm
37             SPVM/Builder.pm
38             SPVM/Builder/Resource.pm
39             SPVM/Builder/Runtime.pm
40             SPVM/Builder/Stack.pm
41             SPVM/Builder/Util/API.pm
42             SPVM/Builder/Util.pm
43             SPVM/Document/ExchangeAPI.pm
44             SPVM/ExchangeAPI/Class.pm
45             SPVM/ExchangeAPI/Error.pm
46             SPVM/ExchangeAPI.pm
47             SPVM/Global.pm
48             SPVM.pm
49             );
50            
51 1110         6729 return \@spvm_builder_class_file_names;
52             }
53              
54             sub get_spvm_core_header_file_names {
55            
56 1110     1110 0 32379 my @spvm_core_header_file_names = qw(
57             spvm_allocator.h
58             spvm_allow.h
59             spvm_api_allocator.h
60             spvm_api_arg.h
61             spvm_api_basic_type.h
62             spvm_api_class_var.h
63             spvm_api_compiler.h
64             spvm_api_field.h
65             spvm_api.h
66             spvm_api_method.h
67             spvm_api_class_file.h
68             spvm_api_runtime.h
69             spvm_api_string_buffer.h
70             spvm_api_type.h
71             spvm_api_internal.h
72             spvm_array_field_access.h
73             spvm_attribute.h
74             spvm_basic_type.h
75             spvm_block.h
76             spvm_call_method.h
77             spvm_case_info.h
78             spvm_check.h
79             spvm_class_var_access.h
80             spvm_class_var.h
81             spvm_compiler.h
82             spvm_constant.h
83             spvm_dumper.h
84             spvm_field_access.h
85             spvm_field.h
86             spvm_hash.h
87             spvm_implement.h
88             spvm_interface.h
89             spvm_list.h
90             spvm_method.h
91             spvm_mutex.h
92             spvm_class_file.h
93             spvm_native.h
94             spvm_object.h
95             spvm_opcode_builder.h
96             spvm_opcode.h
97             spvm_opcode_list.h
98             spvm_op.h
99             spvm_precompile.h
100             spvm_public_api.h
101             spvm_runtime_arg.h
102             spvm_runtime_basic_type.h
103             spvm_runtime_class_var.h
104             spvm_runtime_field.h
105             spvm_runtime.h
106             spvm_runtime_method.h
107             spvm_runtime_string.h
108             spvm_strerror.h
109             spvm_string_buffer.h
110             spvm_string.h
111             spvm_switch_info.h
112             spvm_toke.h
113             spvm_typedecl.h
114             spvm_type.h
115             spvm_use.h
116             spvm_var_decl.h
117             spvm_var.h
118             spvm_vm.h
119             spvm_weaken_backref.h
120             spvm_yacc.h
121             spvm_yacc_util.h
122             );
123            
124 1110         5345 return \@spvm_core_header_file_names;
125             }
126              
127             sub get_spvm_core_source_file_names {
128            
129 1112     1112 0 24804 my @spvm_core_source_file_names = qw(
130             spvm_allocator.c
131             spvm_allow.c
132             spvm_api_allocator.c
133             spvm_api_arg.c
134             spvm_api_basic_type.c
135             spvm_api.c
136             spvm_api_class_var.c
137             spvm_api_compiler.c
138             spvm_api_field.c
139             spvm_api_method.c
140             spvm_api_class_file.c
141             spvm_api_runtime.c
142             spvm_api_string_buffer.c
143             spvm_api_type.c
144             spvm_api_internal.c
145             spvm_array_field_access.c
146             spvm_attribute.c
147             spvm_basic_type.c
148             spvm_block.c
149             spvm_call_method.c
150             spvm_case_info.c
151             spvm_check.c
152             spvm_class_var_access.c
153             spvm_class_var.c
154             spvm_compiler.c
155             spvm_constant.c
156             spvm_dumper.c
157             spvm_field_access.c
158             spvm_field.c
159             spvm_hash.c
160             spvm_interface.c
161             spvm_list.c
162             spvm_method.c
163             spvm_mutex.c
164             spvm_class_file.c
165             spvm_op.c
166             spvm_opcode_builder.c
167             spvm_opcode.c
168             spvm_opcode_list.c
169             spvm_precompile.c
170             spvm_runtime.c
171             spvm_strerror.c
172             spvm_string_buffer.c
173             spvm_string.c
174             spvm_switch_info.c
175             spvm_toke.c
176             spvm_type.c
177             spvm_use.c
178             spvm_var.c
179             spvm_var_decl.c
180             spvm_vm.c
181             spvm_yacc.c
182             spvm_yacc_util.c
183             );
184              
185 1112         6206 return \@spvm_core_source_file_names;
186             }
187              
188             sub get_spvm_compiler_and_runtime_class_file_names {
189 1110     1110 0 13031 my @spvm_compiler_and_runtime_class_file_names = qw(
190             SPVM/Native/Arg.c
191             SPVM/Native/Arg.spvm
192             SPVM/Native/BasicType.c
193             SPVM/Native/BasicType.spvm
194             SPVM/Native.c
195             SPVM/Native/ClassVar.c
196             SPVM/Native/ClassVar.spvm
197             SPVM/Native/Compiler.c
198             SPVM/Native/Compiler.spvm
199             SPVM/Native/Env.c
200             SPVM/Native/Env.spvm
201             SPVM/Native/Field.c
202             SPVM/Native/Field.spvm
203             SPVM/Native/Method.c
204             SPVM/Native/MethodCall.c
205             SPVM/Native/MethodCall/Callback.spvm
206             SPVM/Native/MethodCall.spvm
207             SPVM/Native/Method.spvm
208             SPVM/Native/ClassFile.c
209             SPVM/Native/ClassFile.spvm
210             SPVM/Native/Runtime.c
211             SPVM/Native/Runtime.spvm
212             SPVM/Native.spvm
213             SPVM/Native/Stack.c
214             SPVM/Native/Stack.spvm
215             );
216            
217 1110         5433 return \@spvm_compiler_and_runtime_class_file_names;
218             }
219              
220             sub need_generate {
221 1110     1110 0 4290 my ($opt) = @_;
222            
223 1110         3358 my $force = $opt->{force};
224 1110         2586 my $input_files = $opt->{input_files};
225 1110         2606 my $output_file = $opt->{output_file};
226            
227             # SPVM::Builder classes
228 1110         5959 my $spvm_dependent_files = &get_spvm_dependent_files;
229            
230 1110         2111 my $spvm_dependent_files_mtime_max;
231 1110         2200 $spvm_dependent_files_mtime_max = 0;
232 1110         5266 for my $spvm_core_file (@$spvm_dependent_files) {
233 188700         2179575 my $spvm_core_file_mtime = (stat($spvm_core_file))[9];
234 188700 100       630358 if ($spvm_core_file_mtime > $spvm_dependent_files_mtime_max) {
235 2220         4947 $spvm_dependent_files_mtime_max = $spvm_core_file_mtime;
236             }
237             }
238              
239 1110         3185 my $need_generate;
240 1110 50       4325 if ($force) {
241 0         0 $need_generate = 1;
242             }
243             else {
244 1110 100       35834 if (!-f $output_file) {
245 848         3028 $need_generate = 1;
246             }
247             else {
248 262         885 my $input_files_mtime_max = 0;
249 262         545 my $exists_input_file_at_least_one;
250 262         810 for my $input_file (@$input_files) {
251 507 100       7345 if (-f $input_file) {
252 445         1221 $exists_input_file_at_least_one = 1;
253 445         5420 my $input_file_mtime = (stat($input_file))[9];
254 445 100       2147 if ($input_file_mtime > $input_files_mtime_max) {
255 310         831 $input_files_mtime_max = $input_file_mtime;
256             }
257             }
258             }
259 262 50       1019 if ($exists_input_file_at_least_one) {
260 262         3287 my $output_file_mtime = (stat($output_file))[9];
261            
262 262 50       1351 if (defined $spvm_dependent_files_mtime_max) {
263 262 50       928 if ($spvm_dependent_files_mtime_max > $input_files_mtime_max) {
264 0         0 $input_files_mtime_max = $spvm_dependent_files_mtime_max;
265             }
266             }
267            
268 262 100       943 if ($input_files_mtime_max > $output_file_mtime) {
269 1         14 $need_generate = 1;
270             }
271             }
272             }
273             }
274            
275 1110         21920 return $need_generate;
276             }
277              
278             sub slurp_binary {
279 184     184 0 414 my ($file) = @_;
280            
281 184 50       10714 open my $fh, '<', $file
282             or confess "Can't open file \"$file\":$!";
283            
284 184         649 my $content = do { local $/; <$fh> };
  184         1352  
  184         8079  
285            
286 184         3209 return $content;
287             }
288              
289             sub slurp_utf8 {
290 184     184 0 420 my ($file) = @_;
291            
292 184         650 my $content = &slurp_binary($file);
293            
294 184         1514 $content = decode('UTF-8', $content);
295            
296 184         16987 return $content;
297             }
298              
299             sub file_contains {
300 184     184 0 19635700 my ($file, $string) = @_;
301            
302 184         774 my $content = &slurp_utf8($file);
303            
304 184         436 my $contains;
305 184 100       2663 if (index($content, $string) >= 0) {
306 177         356 $contains = 1;
307             }
308            
309 184         2118 return $contains;
310             }
311              
312             sub spurt_binary {
313 2     2 0 37 my ($file, $content) = @_;
314            
315 2 50       366 open my $fh, '>:raw', $file
316             or confess "Can't open file \"$file\":$!";
317            
318 2         323 print $fh $content;
319             }
320              
321             sub create_cfunc_name {
322 41368     41368 0 73636 my ($basic_type_name, $method_name, $category) = @_;
323            
324 41368         51316 my $prefix;
325 41368 100       80394 if ($category eq 'native') {
    50          
326 25764         34765 $prefix = 'SPVM__';
327             }
328             elsif ($category eq 'precompile') {
329 15604         23286 $prefix = 'SPVMPRECOMPILE__'
330             }
331            
332             # Precompile Method names
333 41368         106271 my $method_abs_name_under_score = "${basic_type_name}::$method_name";
334 41368         155232 $method_abs_name_under_score =~ s/:/_/g;
335 41368         84511 my $cfunc_name = "$prefix$method_abs_name_under_score";
336            
337 41368         75634 return $cfunc_name;
338             }
339              
340             sub unindent {
341 0     0 0 0 my $str = shift;
342 0 0       0 my $min = min map { m/^([ \t]*)/; length $1 || () } split "\n", $str;
  0         0  
  0         0  
343 0 0       0 $str =~ s/^[ \t]{0,$min}//gm if $min;
344 0         0 return $str;
345             }
346              
347             sub extract_usage {
348 0 0   0 0 0 my $file = @_ ? "$_[0]" : (caller)[1];
349            
350 0         0 open my $handle, '>', \my $output;
351            
352 0         0 pod2usage -exitval => 'noexit', -input => $file, -output => $handle, -verbose => 99, -sections => "Usage";
353 0         0 $output =~ s/^.*\n|\n$//;
354 0         0 $output =~ s/\n$//;
355              
356 0         0 return SPVM::Builder::Util::unindent($output);
357             }
358              
359             sub getopt {
360 0 0   0 0 0 my ($array, $opts) = map { ref $_[0] eq 'ARRAY' ? shift : $_ } \@ARGV, [];
  0         0  
361 0         0 my $save = Getopt::Long::Configure(qw(default no_auto_abbrev no_ignore_case),
362             @$opts);
363 0         0 GetOptionsFromArray $array, @_;
364 0         0 Getopt::Long::Configure($save);
365             }
366              
367             sub convert_class_file_to_dynamic_lib_file {
368 3159     3159 0 7306 my ($class_file, $category) = @_;
369            
370 3159         35681 my $dlext = $Config{dlext};
371 3159         32922 $class_file =~ s/\.[^.]+$//;
372 3159         7017 my $dynamic_lib_category_file = $class_file;
373 3159 100       15117 $dynamic_lib_category_file .= $category eq 'native' ? ".$dlext" : ".$category.$dlext";
374            
375 3159         7734 return $dynamic_lib_category_file;
376             }
377              
378             sub convert_basic_type_name_to_dynamic_lib_rel_file {
379 2     2 0 6 my ($basic_type_name, $category) = @_;
380            
381 2         15 my $dlext = $Config{dlext};
382 2         7 my $dynamic_lib_category_rel_file = &convert_basic_type_name_to_rel_file($basic_type_name);
383 2 100       11 $dynamic_lib_category_rel_file .= $category eq 'native' ? ".$dlext" : ".$category.$dlext";
384            
385 2         3 return $dynamic_lib_category_rel_file;
386             }
387              
388             sub convert_basic_type_name_to_category_rel_file {
389 1021     1021 0 4911 my ($basic_type_name, $category, $ext) = @_;
390            
391 1021         6175 $basic_type_name =~ s/^SPVM:://;
392            
393 1021         6562 my $rel_file_with_ext = "SPVM::$basic_type_name";
394 1021         9529 $rel_file_with_ext =~ s/::/\//g;
395 1021 100       6131 $rel_file_with_ext .= $category eq 'native' ? "" : ".$category";
396 1021 100       4112 if (defined $ext) {
397 692         2163 $rel_file_with_ext .= ".$ext";
398             }
399            
400 1021         5394 return $rel_file_with_ext;
401             }
402              
403             sub convert_basic_type_name_to_rel_dir {
404 284     284 0 1034 my ($basic_type_name) = @_;
405              
406 284         999 $basic_type_name =~ s/^SPVM:://;
407              
408 284         617 my $rel_dir;
409 284         1610 my $rel_file = "SPVM::$basic_type_name";
410 284         2761 $rel_file =~ s/::/\//g;
411 284         10941 $rel_dir = dirname $rel_file;
412            
413 284         2043 return $rel_dir;
414             }
415              
416             sub convert_basic_type_name_to_rel_file {
417 369     369 0 1705 my ($basic_type_name, $ext) = @_;
418              
419 369         1450 $basic_type_name =~ s/^SPVM:://;
420            
421 369         2010 my $rel_file_with_ext = "SPVM::$basic_type_name";
422 369         3547 $rel_file_with_ext =~ s/::/\//g;
423            
424 369 100       1819 if (defined $ext) {
425 355         1532 $rel_file_with_ext .= ".$ext";
426             }
427            
428 369         1971 return $rel_file_with_ext;
429             }
430              
431             sub remove_basic_type_name_part_from_file {
432 23     23 0 149 my ($file, $basic_type_name) = @_;
433              
434 23         116 $basic_type_name =~ s/^SPVM:://;
435            
436 23         243 $file =~ s/\.spvm$//;
437 23         159 my $class_file = "SPVM::$basic_type_name";
438 23         246 $class_file =~ s/::/\//g;
439 23         1077 $file =~ s/$class_file$//;
440 23         265 $file =~ s/[\\\/]$//;
441            
442 23         134 return $file;
443             }
444              
445             sub create_make_rule_native {
446 1     1 0 111 my $basic_type_name = shift;
447            
448 1         5 create_make_rule($basic_type_name, 'native', @_);
449             }
450              
451             sub create_make_rule_precompile {
452 1     1 0 982 my $basic_type_name = shift;
453            
454 1         4 create_make_rule($basic_type_name, 'precompile', @_);
455             }
456              
457             sub create_make_rule {
458 2     2 0 6 my ($basic_type_name, $category, $options) = @_;
459            
460 2   50     8 $options ||= {};
461 2         5 $basic_type_name =~ s/^SPVM:://;
462            
463 2         3 my $module_base_name = $basic_type_name;
464 2         5 $module_base_name =~ s/^.+:://;
465            
466 2 50       8 my $lib_dir = defined $options->{lib_dir} ? $options->{lib_dir} : 'lib';
467            
468 2         5 my $class_rel_file = &convert_basic_type_name_to_rel_file($basic_type_name, 'spvm');
469            
470 2         4 my $noext_file = $class_rel_file;
471 2         10 $noext_file =~ s/\.[^\.]+$//;
472            
473 2         5 my $spvm_file = $noext_file;
474 2         4 $spvm_file .= '.spvm';
475 2         5 $spvm_file = "$lib_dir/$spvm_file";
476            
477             # Dependency files
478 2         3 my @deps;
479            
480             # Dependency c source files
481 2 0       77 push @deps, grep { $_ ne '.' && $_ ne '..' } glob "$lib_dir/$class_rel_file/*";
  0         0  
482              
483 2         9 push @deps, $spvm_file;
484            
485             # Dependency native class file
486 2 100       8 if ($category eq 'native') {
487             # Config
488 1         3 my $config_file = $noext_file;
489 1         2 $config_file .= '.config';
490 1         5 $config_file = "$lib_dir/$config_file";
491 1         10 my $config = SPVM::Builder::Config->load_config($config_file);
492 1         3 push @deps, $config_file;
493            
494             # Native class
495 1         2 my $native_class_file = $noext_file;
496 1         4 my $native_class_file_ext = $config->ext;
497 1         3 $native_class_file .= ".$native_class_file_ext";
498 1         4 $native_class_file = "$lib_dir/$native_class_file";
499 1         2 push @deps, $native_class_file;
500            
501             # Native include
502 1         3 my $native_include_dir = "$lib_dir/$noext_file.native/include";
503 1         2 my @native_include_files;
504 1 50       23 if (-d $native_include_dir) {
505 0 0   0   0 find({wanted => sub { if (-f $_) { push @native_include_files, $_ } }, no_chdir => 1}, $native_include_dir);
  0         0  
  0         0  
506             }
507 1         4 push @deps, @native_include_files;
508            
509             # Native source
510 1         4 my $native_src_dir = "$lib_dir/$noext_file.native/src";
511 1         1 my @native_src_files;
512 1 50       18 if (-d $native_src_dir) {
513 0 0   0   0 find({wanted => sub { if (-f $_) { push @native_src_files, $_ } }, no_chdir => 1}, $native_src_dir);
  0         0  
  0         0  
514             }
515 1         15 push @deps, @native_src_files;
516             }
517            
518             # Shared library file
519 2         7 my $dynamic_lib_rel_file = &convert_basic_type_name_to_dynamic_lib_rel_file($basic_type_name, $category);
520 2         6 my $dynamic_lib_file = "blib/lib/$dynamic_lib_rel_file";
521            
522 2         3 my $make_rule = '';
523            
524             # dynamic section
525 2         14 $make_rule .= "dynamic :: $dynamic_lib_file\n";
526 2         5 $make_rule .= "\t\$(NOECHO) \$(NOOP)\n\n";
527            
528             # Get source files
529 2         9 $make_rule .= "$dynamic_lib_file :: @deps\n";
530 2         6 $make_rule .= "\t$^X -Mblib -MSPVM::Builder::API -e \"SPVM::Builder::API->new(build_dir => '.spvm_build')->build_dynamic_lib_dist_$category('$basic_type_name')\"\n\n";
531            
532 2         9 return $make_rule;
533             }
534              
535             sub get_spvm_dependent_files {
536            
537 1110     1110 0 3133 my @spvm_dependent_files;
538 1110 50       7721 if (my $builder_loaded_file = $INC{'SPVM/Builder/Util.pm'}) {
539 1110         4532 my $builder_loaded_dir = $builder_loaded_file;
540 1110         12076 $builder_loaded_dir =~ s|[/\\]SPVM/Builder/Util\.pm$||;
541            
542             # SPVM::Builder class files
543 1110         8319 my $spvm_core_perl_class_file_names = &get_spvm_core_perl_class_file_names();
544 1110         6241 for my $spvm_core_perl_class_file_name (@$spvm_core_perl_class_file_names) {
545 29970         119273 my $spvm_core_perl_class_file = "$builder_loaded_dir/$spvm_core_perl_class_file_name";
546 29970 50       421085 unless (-f $spvm_core_perl_class_file) {
547 0         0 confess "Can't find $spvm_core_perl_class_file";
548             }
549 29970         127640 push @spvm_dependent_files, $spvm_core_perl_class_file;
550             }
551            
552             # SPVM core header files
553 1110         6602 my $spvm_core_header_file_names = &get_spvm_core_header_file_names();
554 1110         3977 for my $spvm_core_header_file_name (@$spvm_core_header_file_names) {
555 72150         347616 my $spvm_core_header_file = "$builder_loaded_dir/SPVM/Builder/include/$spvm_core_header_file_name";
556 72150 50       997155 unless (-f $spvm_core_header_file) {
557 0         0 confess "Can't find $spvm_core_header_file";
558             }
559 72150         298351 push @spvm_dependent_files, $spvm_core_header_file;
560             }
561            
562             # SPVM core source files
563 1110         5390 my $spvm_core_source_file_names = &get_spvm_core_source_file_names();
564 1110         4074 for my $spvm_core_source_file_name (@$spvm_core_source_file_names) {
565 58830         272712 my $spvm_core_source_file = "$builder_loaded_dir/SPVM/Builder/src/$spvm_core_source_file_name";
566 58830 50       820661 unless (-f $spvm_core_source_file) {
567 0         0 confess "Can't find $spvm_core_source_file";
568             }
569 58830         257376 push @spvm_dependent_files, $spvm_core_source_file;
570             }
571            
572             # SPVM Compiler and Runtime class file names
573 1110         5259 my $spvm_compiler_and_runtime_class_file_names = &get_spvm_compiler_and_runtime_class_file_names();
574 1110         3857 for my $spvm_compiler_and_runtime_class_file_name (@$spvm_compiler_and_runtime_class_file_names) {
575 27750         102509 my $spvm_compiler_and_runtime_class_file = "$builder_loaded_dir/$spvm_compiler_and_runtime_class_file_name";
576 27750 50       372974 unless (-f $spvm_compiler_and_runtime_class_file) {
577 0         0 confess "Can't find $spvm_compiler_and_runtime_class_file";
578             }
579 27750         110915 push @spvm_dependent_files, $spvm_compiler_and_runtime_class_file;
580             }
581             }
582            
583 1110 50       4166 unless (@spvm_dependent_files) {
584 0         0 confess "[Unexpected Error]SPVM dependent files are not found";
585             }
586            
587 1110         3353 return \@spvm_dependent_files;
588             }
589              
590             sub get_config_file_from_basic_type_name {
591 22     22 0 111 my ($basic_type_name, $mode) = @_;
592            
593 22         111 my $ext = 'config';
594 22 100       113 if (defined $mode) {
595 3         17 $ext = "$mode.$ext";
596             }
597            
598 22         204 my $config_file_base = SPVM::Builder::Util::convert_basic_type_name_to_rel_file($basic_type_name, $ext);
599 22         210 my $config_file;
600 22         197 for my $inc (@INC) {
601 22         157 my $config_file_tmp = "$inc/$config_file_base";
602 22 50       714 if (-f $config_file_tmp) {
603 22         78 $config_file = $config_file_tmp;
604 22         97 last;
605             }
606             }
607 22 50       143 unless (defined $config_file) {
608 0         0 confess "Can't find the config file \"$config_file_base\" in (@INC)";
609             }
610            
611 22         101 return $config_file;
612             }
613              
614             sub get_builder_dir_from_config_class {
615 386     386 0 2119 my $builder_config_dir = $INC{"SPVM/Builder/Config.pm"};
616 386         1010 my $builder_dir = $builder_config_dir;
617 386         4293 $builder_dir =~ s/\/Config\.pm$//;
618 386         2185 return $builder_dir;
619             }
620              
621             sub create_build_src_path {
622 315     315 0 1589 my ($build_dir, $rel_file) = @_;
623            
624 315         1242 my $build_src_path = "$build_dir/work/src";
625 315 100       1399 if (defined $rel_file) {
626 2         6 $build_src_path .= "/$rel_file";
627             }
628            
629 315         1320 return $build_src_path;
630             }
631              
632             sub create_build_include_path {
633 0     0 0 0 my ($build_dir, $rel_file) = @_;
634            
635 0         0 my $build_include_path = "$build_dir/work/include";
636 0 0       0 if (defined $rel_file) {
637 0         0 $build_include_path .= "/$rel_file";
638             }
639            
640 0         0 return $build_include_path;
641             }
642              
643             sub create_build_object_path {
644 346     346 0 1782 my ($build_dir, $rel_file) = @_;
645            
646 346         1555 my $build_output_path = "$build_dir/work/object";
647 346 100       1799 if (defined $rel_file) {
648 12         110 $build_output_path .= "/$rel_file";
649             }
650            
651 346         1878 return $build_output_path;
652             }
653              
654             sub create_build_lib_path {
655 329     329 0 1723 my ($build_dir, $rel_file) = @_;
656            
657 329         1373 my $build_lib_path = "$build_dir/work/lib";
658 329 50       1387 if (defined $rel_file) {
659 0         0 $build_lib_path .= "/$rel_file";
660             }
661            
662 329         1096 return $build_lib_path;
663             }
664              
665             sub create_dl_func_list {
666 329     329 0 1394 my ($basic_type_name, $method_names, $options) = @_;
667            
668 329   50     1413 $options ||= {};
669            
670 329   50     1608 my $category = $options->{category} || '';
671            
672             # dl_func_list
673             # This option is needed Windows DLL file
674 329         1055 my $dl_func_list = [];
675 329         1574 for my $method_name (@$method_names) {
676 3380         6896 my $cfunc_name = SPVM::Builder::Util::create_cfunc_name($basic_type_name, $method_name, $category);
677 3380         8099 push @$dl_func_list, $cfunc_name;
678             }
679            
680             # This is bad hack to suppress boot strap function error.
681 329 50       8070 unless (@$dl_func_list) {
682 0         0 push @$dl_func_list, '';
683             }
684            
685 329         1452 return $dl_func_list;
686             }
687              
688             sub get_dynamic_lib_file_dist {
689 3159     3159 0 8759 my ($class_file, $category) = @_;
690              
691 3159         9990 my $dynamic_lib_file = SPVM::Builder::Util::convert_class_file_to_dynamic_lib_file($class_file, $category);
692            
693 3159         7975 return $dynamic_lib_file;
694             }
695              
696             sub get_method_addresses {
697 3159     3159 0 12372 my ($dynamic_lib_file, $basic_type_name, $method_names, $category) = @_;
698            
699 3159         7729 my $method_addresses = {};
700 3159 50       15696 if (@$method_names) {
701 3159         6842 my $method_infos = [];
702 3159         8389 for my $method_name (@$method_names) {
703 37988         54001 my $method_info = {};
704 37988         72881 $method_info->{basic_type_name} = $basic_type_name;
705 37988         55000 $method_info->{method_name} = $method_name;
706 37988         71019 push @$method_infos, $method_info;
707             }
708            
709 3159         9035 for my $method_info (@$method_infos) {
710 37988         64271 my $basic_type_name = $method_info->{basic_type_name};
711 37988         52393 my $method_name = $method_info->{method_name};
712              
713 37988         47624 my $cfunc_address;
714 37988 50       61793 if ($dynamic_lib_file) {
715 37988         658066 my $dynamic_lib_libref = DynaLoader::dl_load_file($dynamic_lib_file);
716            
717 37988 50       76597 if ($dynamic_lib_libref) {
718              
719 37988         74616 my $cfunc_name = SPVM::Builder::Util::create_cfunc_name($basic_type_name, $method_name, $category);
720 37988         118315 $cfunc_address = DynaLoader::dl_find_symbol($dynamic_lib_libref, $cfunc_name);
721 37988 50       84724 unless ($cfunc_address) {
722 0         0 my $dl_error = DynaLoader::dl_error();
723 0         0 my $error = <<"EOS";
724             Can't find native function \"$cfunc_name\" corresponding to ${basic_type_name}->$method_name in \"$dynamic_lib_file\"
725              
726             You must write the following definition.
727             --------------------------------------------------
728             #include
729              
730             int32_t $cfunc_name(SPVM_ENV* env, SPVM_VALUE* stack) {
731            
732             return 0;
733             }
734             --------------------------------------------------
735              
736             $dl_error
737             EOS
738 0         0 confess $error;
739             }
740             }
741             else {
742 0         0 my $dl_error = DynaLoader::dl_error();
743 0         0 confess "The DynaLoader::dl_load_file function failed:Can't load the \"$dynamic_lib_file\" file for $category methods in $basic_type_name class: $dl_error";
744             }
745             }
746             else {
747 0         0 confess "DLL file is not specified";
748             }
749            
750 37988         106900 $method_addresses->{$method_name} = $cfunc_address;
751             }
752             }
753            
754 3159         46152 return $method_addresses;
755             }
756              
757             sub create_default_config {
758            
759 315     315 0 4923 my $config = SPVM::Builder::Config->new_gnu99(file_optional => 1);
760            
761 315         1160 return $config;
762             }
763              
764             sub get_normalized_env {
765 3066     3066 0 11458 my ($name) = @_;
766            
767 3066         8611 my $value = $ENV{$name};
768            
769 3066 50 66     13958 if (defined $value && !length $value) {
770 0         0 $value = undef;
771             }
772            
773 3066         8012 return $value;
774             }
775              
776             sub get_version_string {
777 0     0 0 0 my ($spvm_class_file) = @_;
778            
779 0 0       0 open my $spvm_module_fh, '<', $spvm_class_file or die "Can't open the file \"$spvm_class_file\": $!";
780 0         0 local $/;
781 0         0 my $content = <$spvm_module_fh>;
782 0         0 my $version_string;
783 0 0       0 if ($content =~ /\bversion\s*"([\d\._]+)"\s*;/) {
784 0         0 $version_string = $1;
785             }
786              
787 0 0       0 unless (defined $version_string) {
788 0         0 confess "The version string can't be find in $spvm_class_file file";
789             }
790            
791 0         0 return $version_string;
792             }
793              
794             sub get_spvm_version_string {
795            
796 2     2 0 1795 my $builder_dir = &get_builder_dir_from_config_class;
797 2         7 my $spvm_api_header_file = "$builder_dir/include/spvm_native.h";
798            
799 2 50       105 open my $spvm_module_fh, '<', $spvm_api_header_file or die "Can't open the file \"$spvm_api_header_file\": $!";
800 2         13 local $/;
801 2         193 my $content = <$spvm_module_fh>;
802 2         9 my $version_string;
803 2 50       26 if ($content =~ /#define\s+SPVM_NATIVE_VERSION_NUMBER\s* ([\d\._]+)/) {
804 2         10 $version_string = $1;
805             }
806            
807 2 50       8 unless (defined $version_string) {
808 0         0 confess "The version string can't be find in $spvm_api_header_file file";
809             }
810            
811 2         37 return $version_string;
812             }
813              
814             1;
815              
816             =head1 Name
817              
818             SPVM::Builder::Util - Builder Utilities
819              
820             =head1 Description
821              
822             The SPVM::Builder::Util class has utility functions for the L class.
823              
824             =head1 Copyright & License
825              
826             Copyright (c) 2023 Yuki Kimoto
827              
828             MIT License