File Coverage

blib/lib/Filter/Dockerfile.pm
Criterion Covered Total %
statement 23 73 31.5
branch 3 26 11.5
condition 0 8 0.0
subroutine 7 8 87.5
pod 0 2 0.0
total 33 117 28.2


line stmt bran cond sub pod time code
1             package Filter::Dockerfile;
2 1     1   17164 use Filter::Util::Call;
  1         944  
  1         66  
3 1     1   2503 use LWP::UserAgent;
  1         58064  
  1         28  
4 1     1   7 use strict;
  1         6  
  1         24  
5 1     1   4 use warnings;
  1         1  
  1         38  
6 1     1   427 use version;
  1         1538  
  1         4  
7             our $VERSION = version->declare("0.0.2");
8              
9             sub import {
10 1     1   11 my ($type) = @_;
11 1         11 my ($ref) = {
12             ua => LWP::UserAgent->new()
13             };
14 1         3333 filter_add(bless $ref);
15             }
16              
17             sub filter {
18 3     3 0 434 my ($self) = @_;
19 3 100       1332 filter_read() || return 0;
20 2 50       5 if ( /^INCLUDE/ ) {
21 0         0 while( substr($_,-2) eq "\\\n" ) {
22 0         0 $_ = substr($_,0,-2);
23 0 0       0 filter_read() || return 0;
24             }
25 0         0 my @args = split(/\s+/, $_);
26 0         0 shift @args;
27 0         0 my $merge = 0;
28 0         0 my $exclude = {};
29 0         0 my $include = {};
30 0 0       0 if ( $args[0] eq 'MERGE' ) {
31 0         0 $merge++;
32 0         0 shift @args;
33             }
34 0         0 my @uris = ();
35 0         0 for my $arg ( @args ) {
36 0 0       0 if ( $arg =~ /^(-)?(ADD|CMD|COPY|ENTRYPOINT|ENV|EXPOSE|FROM|INCLUDE|LABEL|MAINTAINER|ONBUILD|RUN|USER|VOLUME|WORKDIR)$/ ) {
37 0 0       0 if( $1 ) {
38 0         0 $exclude->{$2}++;
39             } else {
40 0         0 $include->{$2}++;
41             }
42 0         0 next;
43             }
44 0         0 push @uris, $arg;
45             }
46              
47 0         0 my @content = ();
48 0         0 for my $uri ( @uris ) {
49 0 0       0 if ( -f $uri ) {
50 0         0 local $/ = undef;
51 0   0     0 open my $fh, $uri || die "$uri: $!";
52 0         0 push @content, join("", <$fh>);
53             } else {
54 0         0 push @content, $self->{ua}->get($uri)->decoded_content();
55             }
56             }
57 0         0 chomp(@content);
58 0         0 @content = merge($merge, \@content, $include, $exclude);
59 0         0 $_ = "print <<'EOM';\n".join("\n", @content)."\nEOM\n";
60             } else {
61 2         5 $_ = "print <<'EOM';\n${_}EOM\n";
62             }
63 2         51 return 1;
64             }
65              
66             sub merge {
67 0     0 0   my ($merge, $docs, $include, $exclude) = @_;
68 0           my @result = ();
69 0           my %ops = ();
70 0           for my $doc (@$docs) {
71 0           my @lines = split( /(?
72 0           for my $line (@lines) {
73 0           my ($op, $details) = split(/\s+/, $line, 2);
74 0 0         next unless $op;
75 0 0         next if exists $exclude->{$op};
76 0 0 0       next if keys %$include && ! exists $include->{$op};
77 0 0 0       if ( $merge && exists $ops{$op} ) {
78 0           my $sref = $ops{$op};
79 0 0         if ( $op =~ /^(ENV|LABEL)$/ ) {
    0          
80 0           $$sref .= " \\\n" . " "x(length($1)+1) . "$details";
81             } elsif ( $op eq "RUN" ) {
82 0           $$sref .= " && \\\n $details";
83 0           while( (my $ix = index($$sref, "apt-get update", index($$sref, "apt-get update")+1)) > 0 ) {
84 0           substr($$sref, $ix, 14) = "echo skipping redundent apt-get-update";
85             }
86             } else {
87 0           push @result, $line;
88             }
89             } else {
90 0           push @result, $line;
91 0           $ops{$op} = \$result[-1];
92             }
93             }
94             }
95 0           return @result;
96             }
97              
98             1;
99              
100             __END__