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

package Filter::Dockerfile;
use Filter::Util::Call;
use LWP::UserAgent;
use strict;
use warnings;
use version;
our $VERSION = version->declare("0.0.1");

sub import {
    my ($type) = @_;
    my ($ref) = {
        ua => LWP::UserAgent->new()
    };
    filter_add(bless $ref);
}

sub filter {
    my ($self) = @_;
    filter_read() || return 0;
    if ( /^INCLUDE/ ) {
        while( substr($_,-2) eq "\\\n" ) {
            $_ = substr($_,0,-2);
            filter_read() || return 0;
        }
        my @args = split(/\s+/, $_);
        shift @args;
        my $merge = 0;
        my $exclude = {};
        my $include = {};
        if ( $args[0] eq 'MERGE' ) {
            $merge++;
            shift @args;
        }
        my @uris = ();
        for my $arg ( @args ) {
            if ( $arg =~ /^(-)?(ADD|CMD|COPY|ENTRYPOINT|ENV|EXPOSE|FROM|INCLUDE|LABEL|MAINTAINER|ONBUILD|RUN|USER|VOLUME|WORKDIR)$/ ) {
                if( $1 ) {
                    $exclude->{$2}++;
                } else {
                    $include->{$2}++;
                }
                next;
            }
            push @uris, $arg;
        }

        my @content = ();
        for my $uri ( @uris ) {
            if ( -f $uri ) {
                local $/ = undef;
                open my $fh, $uri || die "$uri: $!";
                push @content, join("", <$fh>);
            } else {
                push @content, $self->{ua}->get($uri)->decoded_content();
            }
        }
        chomp(@content);
        @content = merge($merge, \@content, $include, $exclude);
        $_ = "print <<'EOM';\n".join("\n", @content)."\nEOM\n";
    } else {
        $_ = "print <<'EOM';\n${_}EOM\n";
    }
    return 1;
}

sub merge {
    my ($merge, $docs, $include, $exclude) = @_;
    my @result = ();
    my %ops = ();
    for my $doc (@$docs) {
        my @lines = split( /(?
        for my $line (@lines) {
            my ($op, $details) = split(/\s+/, $line, 2);
            next unless $op;
            next if exists $exclude->{$op};
            next if keys %$include && ! exists $include->{$op};
            if ( $merge && exists $ops{$op} ) {
                my $sref = $ops{$op};
                if ( $op =~ /^(ENV|LABEL)$/ ) {
                    $$sref .= " \\\n" . " "x(length($1)+1) . "$details";
                } elsif ( $op eq "RUN" ) {
                    $$sref .= " && \\\n    $details";
                    while( (my $ix = index($$sref, "apt-get update", index($$sref, "apt-get update")+1))  > 0 ) {
                        substr($$sref, $ix, 14) = "echo skipping redundent apt-get-update";
                    }
                } else {
                    push @result, $line;
                }
            } else {
                push @result, $line;
                $ops{$op} = \$result[-1];
            }
        }
    }
    return @result;
}

1;

__END__