#!/usr/bin/env perl
use strict;
use warnings FATAL => qw(all);
use base qw(File::Spec); sub MY () {__PACKAGE__}
use File::Basename;
defined (my $file = shift)
or die "Usage: $0 MODULE_FILE\n";
defined (my $modname = file_module($file))
or die "Can't extract module name from $file\n";
my @inc_opt = inc_opt($file, $modname);
if ((system $^X, @inc_opt, -we => "require $modname") == 0) {
print "Module $modname is OK";
} else {
exit $? >> 8;
}
# Extract ModName from:
#
# package ModName;
#
# package ModName {
#
sub file_module {
my ($fn) = @_;
open my $fh, '<', $fn or die "Can't open $fn: $!";
local $/;
local $_ = <$fh>;
while (/(?:^|\n) [\ \t]* (?# line beginning + space)
package [\n\ \t]+ (?# newline is allowed here)
([\w:]+) (?# module name)
\s* [;\{] (?# statement or block)
/xsg) {
my ($modname) = $1;
# Tail of $modname should be equal to it's rootname.
if (((split /::/, $modname)[-1]) eq rootname(basename($fn))) {
return $modname;
}
}
return;
}
sub inc_opt {
my ($file, $modname) = @_;
(my $no_pm = $file) =~ s/\.\w+$//;
my @filepath = MY->splitdir(MY->rel2abs($no_pm));
my @modpath = grep {$_ ne ''} split "::", $modname;
my @popped;
while (@modpath and @filepath and $modpath[-1] eq $filepath[-1]) {
unshift @popped, pop @modpath;
pop @filepath;
}
if (@modpath) {
die "Can't find library root directory of $modname in file $file\n@modpath\n";
}
'-I' . MY->catdir(@filepath);
}
sub rootname { my $fn = shift; $fn =~ s/\.\w+$//; join "", $fn, @_ }