File Coverage

blib/lib/XS/Install/Deps.pm

Criterion	Covered	Total	%
statement	59	87	67.8
branch	11	40	27.5
condition	0	6	0.0
subroutine	9	10	90.0
pod	0	4	0.0
total	79	147	53.7

package
    XS::Install::Deps;
use strict;
use warnings;
use Cwd 'abs_path';
use File::Spec;

sub find_header_deps {
    my $p = shift;
    my $headers = [ grep {$_} map { abs_path($_) } @{$p->{headers} || []} ];
    my $inc     = [ grep {$_} map { abs_path($_) } @{$p->{inc} || []} ];
    my $cache   = {};
    $headers = undef unless @$headers;

    my %ret;
    foreach my $file (@{$p->{files}}) {
        my $absfile = eval { abs_path($file) } or next;
        next unless -f $absfile;
        my $deps = _find_header_deps($absfile, $cache, $inc, $headers) or next;
        $ret{$file} = [keys %$deps];
    }

    return \%ret;
}

sub _find_header_deps {
    my ($file, $cache, $inc, $headers) = @_;
    return $cache->{$file} if exists $cache->{$file};

    my $deps = $cache->{$file} = {};
    my $content = readfile($file);
    my $dir = $file;
    $dir =~ s#[^/\\]+$##;

    while ($content =~ /^\s*#\s*include\s*("|<)([^">]+)(?:"|>)/mg) {
        my ($type, $dep) = ($1, $2);
        my $absdep;
        if ($type eq '"') { # try to find locally first
            $absdep = getfile($dir.$dep);
        }
        unless ($absdep) { # try to find globally
            foreach my $dir (@$inc) {
                $absdep = getfile($dir.'/'.$dep);
                last if $absdep;
            }
        }
        if ($absdep and $headers) { # if supplied, ignore everything that is outside of specified dirs
            my $found;
            foreach my $dir (@$headers) {
                next unless index($absdep, $dir) == 0;
                $found = 1;
                last;
            }
            $absdep = undef unless $found;
        }
        next unless $absdep;

        $deps->{File::Spec->abs2rel($absdep)}++;
        my $subdeps = _find_header_deps($absdep, $cache, $inc, $headers);
        $deps->{$_}++ for keys %$subdeps;
    }

    return $deps;
}

sub find_xsi_deps {
    my $files = shift;
    my %ret;
    foreach my $file (@$files) {
        my $absfile = abs_path($file) or next;
        next unless -f $absfile;
        my $deps = _find_xsi_deps($absfile) or next;
        $ret{$file} = [keys %$deps];
    }
    return \%ret;
}

sub _find_xsi_deps {
    my $file = shift;

    my $content = readfile($file);
    my $dir = $file;
    $dir =~ s#[^/\\]+$##;

    my $deps = {};
    while ($content =~ /^\s*INCLUDE\s*:\s*(.+)/mg) {
        my $xsi = getfile($dir.$1) or next;
        $deps->{File::Spec->abs2rel($xsi)}++;
        my $subdeps = _find_xsi_deps($xsi);
        $deps->{$_}++ for keys %$subdeps;
    }

    return $deps;
}

sub getfile {
    my $f = abs_path($_[0]);
    return undef unless $f and -f $f;
    return $f;
}

sub readfile {
    my $file = shift;
    open my $fh, '<', $file or die "cannot open $file: $!";
    local $/ = undef;
    my $content = <$fh>;
    close $fh;
    return $content;
}

1;