view release on metacpan or  search on metacpan

lib/App/LXC/Container/Data/Debian.pm  view on Meta::CPAN

sub package_of($$)
{
    my ($self, $file) = @_;
    $self->SUPER::package_of($file);
    local $_;
    # TODO: looks like pipe with redirection in shell never fails:
    # uncoverable branch true
    open my $dpkg, '-|', SEARCH . $file . ' 2>/dev/null'
	or  fatal('internal_error__1',
		  'error calling ' . SEARCH . $file . ': '. $!);
    # escape special characters in file name:
    $file =~ s/([]+*?{}[])/\\$1/;
    my $package = undef;
    while (<$dpkg>)
    {
	if (m/^([^ ]+): $file$/)
	{
	    $package = $1;
	    last;
	}
    }