File Coverage

blib/lib/TestML/Setup.pm
Criterion Covered Total %
statement 20 68 29.4
branch 1 30 3.3
condition 0 21 0.0
subroutine 7 10 70.0
pod 0 3 0.0
total 28 132 21.2


line stmt bran cond sub pod time code
1             package TestML::Setup;
2              
3 1     1   598 use TestML::Base;
  1         2  
  1         4  
4              
5 1     1   3 use TestML();
  1         1  
  1         60  
6             BEGIN {
7 1     1   2 for (qw( YAML::XS IO::All Template::Toolkit::Simple )) {
8 3 50       27 if (not $ENV{PERL_ZILD_TEST_000_COMPILE_MODULES}) {
9 0 0       0 eval "use $_; 1" or die "TestML::Setup requires $_:\n$@";
10             }
11             }
12             }
13 1     1   5 use File::Basename;
  1         1  
  1         60  
14 1     1   3 use Cwd 'abs_path';
  1         2  
  1         33  
15 1     1   3 use Exporter 'import';
  1         0  
  1         37  
16              
17             our @EXPORT = qw( setup );
18              
19 1     1   5 use constant DEFAULT_TESTML_CONF => './t/testml.yaml';
  1         2  
  1         633  
20              
21             sub setup {
22 0     0 0   my ($testml_conf) = @_;
23 0   0       $testml_conf ||=
      0        
24             $ARGV[0] ||
25             DEFAULT_TESTML_CONF;
26 0 0         die "TestML conf file '$testml_conf' not found"
27             unless -f $testml_conf;
28 0 0         die "TestML conf file must be .yaml"
29             unless $testml_conf =~ /\.ya?ml$/;
30             # File paths are relative to the yaml file location
31 0           my $base = File::Basename::dirname($testml_conf);
32 0           my $conf = YAML::XS::LoadFile($testml_conf);
33             my $source = $conf->{source_testml_dir}
34 0 0         or die "`testml_setup` requires 'source_testml_dir' key in '$testml_conf'";
35             my $target = $conf->{local_testml_dir}
36 0 0         or die "`testml_setup` requires 'local_testml_dir' key in '$testml_conf'";
37 0   0       my $tests = $conf->{test_file_dir} || '.';
38 0           $source = abs_path("$base/$source");
39 0           $target = abs_path("$base/$target");
40 0           $tests = abs_path("$base/$tests");
41 0 0         die "'#{source}' directory does not exist"
42             unless -e $source;
43 0 0         mkdir $target unless -d $target;
44 0 0         mkdir $tests unless -d $tests;
45 0   0       my $template = $conf->{test_file_template} || '';
46 0   0       my $skip = $conf->{exclude_testml_files} || [];
47             my $files = $conf->{include_testml_files} ||
48 0   0       [map $_->filename, grep {"$_" =~ /\.tml$/} io($source)->all_files];
49 0           for my $file (sort @$files) {
50 0 0         next if grep {$_ eq $file} @$skip;
  0            
51 0           my $s = "$source/$file";
52 0           my $t = "$target/$file";
53 0 0 0       if (not -f $t or io($s)->all ne io($t)->all) {
54 0           print "Copying ${\ relative_path($s)} to ${\ relative_path($t)}\n";
  0            
  0            
55 0           io($t)->print(io($s)->all);
56             }
57 0 0         if ($template) {
58 0           (my $test = $file) =~ s/\.tml$/.t/;
59             $test = $conf->{test_file_prefix} . $test
60 0 0         if $conf->{test_file_prefix};
61 0           $test = abs_path "$tests/$test";
62 0           my ($volume, $directories, $file) =
63             File::Spec->splitpath(relative_path($t, $base));
64 0           my $path = [
65             grep $_, File::Spec->splitdir($directories), $file
66             ];
67 0           my $hash = {
68             testml_setup_comment => testml_setup_comment($testml_conf),
69             file => relative_path($t, $base),
70             path => $path,
71             };
72 0           my $code = tt->data($hash)->render(\$template);
73 0 0 0       if (not -f $test or $code ne io($test)->all) {
74 0 0         my $action = -f $test ? 'Updating' : 'Creating';
75 0           print "$action test file '${\ relative_path($test)}'\n";
  0            
76 0           io($test)->print($code);
77             }
78             }
79             }
80             }
81              
82             sub relative_path {
83 0     0 0   my ($path, $base) = @_;
84 0   0       $base ||= '.';
85 0           $base = abs_path($base);
86 0           File::Spec->abs2rel($path, $base);
87             }
88              
89             sub testml_setup_comment {
90 0     0 0   my ($testml_conf) = @_;
91 0           <<"...";
92             # DO NOT EDIT
93             #
94             # This file was generated by TestML::Setup ($TestML::VERSION)
95             #
96             # > perl -MTestML::Setup -e setup $testml_conf
97             ...
98             }
99              
100             1;