# Perl module for UCW Configure Scripts
#
-# (c) 2005 Martin Mares <mj@ucw.cz>
+# (c) 2005--2010 Martin Mares <mj@ucw.cz>
#
# This software may be freely distributed and used according to the terms
# of the GNU Lesser General Public License.
our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
$VERSION = 1.0;
@ISA = qw(Exporter);
- @EXPORT = qw(&Init &Log &Notice &Warn &Fail &IsSet &IsGiven &Set &UnSet &Append &Override &Get &Test &Include &Finish &FindFile &TryFindFile &TryCmd &PkgConfig &TrivConfig &debPrint);
+ @EXPORT = qw(&Init &Log &Notice &Warn &Fail &IsSet &IsGiven &Set &UnSet &Append &Override &Get &Test &TestBool &Include &Finish &FindFile &TryFindFile &DebugDump &PostConfig &AtWrite);
@EXPORT_OK = qw();
%EXPORT_TAGS = ();
}
our %vars;
our %overriden;
+our @postconfigs;
+our @atwrites;
-sub debPrint() {
- print "VARS:\n";
-# print "$_: $vars{$_}\n" foreach( keys %vars );
+sub DebugDump() {
+ print "VARS:\n";
+ print "$_: $vars{$_}\n" foreach( keys %vars );
}
sub Log($) {
print @_;
+ STDOUT->flush;
}
sub Notice($) {
print @_ if $vars{"VERBOSE"};
+ STDOUT->flush;
}
sub Warn($) {
print "WARNING: ", @_;
+ STDOUT->flush;
}
sub Fail($) {
sub Test($$$) {
my ($var,$msg,$sub) = @_;
Log "$msg ... ";
- if (!IsSet($var)) {
- Set $var, &$sub();
+ if (IsSet($var)) {
+ Log Get($var) . " (preset)\n";
+ } else {
+ my $val = &$sub();
+ Set($var, $val);
+ Log "$val\n";
+ }
+}
+
+sub TestBool($$$) {
+ my ($var,$msg,$sub) = @_;
+ Log "$msg ... ";
+ if (IsSet($var) || IsGiven($var)) {
+ Log ((Get($var) ? "yes" : "no") . " (set)\n");
+ } else {
+ my ($val, $comment) = &$sub();
+ Set($var, $val);
+ Log (($val ? "yes" : "no") . "\n");
}
- Log Get($var) . "\n";
}
sub TryFindFile($) {
my ($f) = @_;
- if (-f $f) {
- return $f;
- } elsif ($f !~ /^\// && -f (Get("SRCDIR")."/$f")) {
+ if ($f =~ m{^/}) {
+ return (-f $f) ? $f : undef;
+ } elsif (-f $f) {
+ return "./$f";
+ } elsif (-f (Get("SRCDIR")."/$f")) {
return Get("SRCDIR")."/$f";
} else {
return undef;
require $f;
}
+sub PostConfig(&) {
+ unshift @postconfigs, $_[0];
+}
+
+sub AtWrite(&) {
+ unshift @atwrites, $_[0];
+}
+
sub Finish() {
+ for my $post (@postconfigs) {
+ &$post();
+ }
+
print "\n";
if (Get("SRCDIR") ne ".") {
-d "obj/ucw" or mkdir("obj/ucw", 0777) or Fail "Cannot create obj/ucw directory: $!";
Log "done\n";
- Log "Generating autoconf.h ... ";
- open X, ">obj/autoconf.h" or Fail $!;
- print X "/* Generated automatically by $0, please don't touch manually. */\n";
- foreach my $x (sort keys %vars) {
- # Don't export variables which contain no underscores
- next unless $x =~ /_/;
- my $v = $vars{$x};
- # Try to add quotes if necessary
- $v = '"' . $v . '"' unless ($v =~ /^"/ || $v =~ /^\d*$/);
- print X "#define $x $v\n";
- }
- close X;
- Log "done\n";
-
Log "Generating config.mk ... ";
open X, ">obj/config.mk" or Fail $!;
print X "# Generated automatically by $0, please don't touch manually.\n";
print X "o=obj\n";
close X;
Log "done\n";
-}
-sub TryCmd($) {
- my ($cmd) = @_;
- my $res = `$cmd`;
- defined $res or return;
- chomp $res;
- return $res unless $?;
- return;
-}
-
-sub maybe_manually($) {
- my ($n) = @_;
- if (IsGiven($n)) {
- if (Get("$n")) { Log "YES (set manually)\n"; }
- else { Log "NO (set manually)\n"; }
- return 1;
- }
- return 0;
-}
-
-sub PkgConfig($@) {
- my $pkg = shift @_;
- my %opts = @_;
- my $upper = $pkg; $upper =~ tr/a-z/A-Z/; $upper =~ s/[^0-9A-Z]+/_/g;
- Log "Checking for package $pkg ... ";
- maybe_manually("CONFIG_HAVE_$upper") and return Get("CONFIG_HAVE_$upper");
- my $ver = TryCmd("pkg-config --modversion $pkg 2>/dev/null");
- if (!defined $ver) {
- Log("NONE\n");
- return 0;
- }
- if (defined($opts{minversion})) {
- my $min = $opts{minversion};
- if (!defined TryCmd("pkg-config --atleast-version=$min $pkg")) {
- Log("NO: version $ver is too old (need >= $min)\n");
- return 0;
- }
- }
- Log("YES: version $ver\n");
- Set("CONFIG_HAVE_$upper" => 1);
- Set("CONFIG_VER_$upper" => $ver);
- my $cf = TryCmd("pkg-config --cflags $pkg");
- Set("${upper}_CFLAGS" => $cf) if defined $cf;
- my $lf = TryCmd("pkg-config --libs $pkg");
- Set("${upper}_LIBS" => $lf) if defined $lf;
- return 1;
-}
-
-sub ver_norm($) {
- my ($v) = @_;
- return join(".", map { sprintf("%05s", $_) } split(/\./, $v));
-}
-
-sub TrivConfig($@) {
- my $pkg = shift @_;
- my %opts = @_;
- my $upper = $pkg; $upper =~ tr/a-z/A-Z/; $upper =~ s/[^0-9A-Z]+/_/g;
- Log "Checking for package $pkg ... ";
- maybe_manually("CONFIG_HAVE_$upper") and return Get("CONFIG_HAVE_$upper");
- my $pc = $opts{script};
- my $ver = TryCmd("$pc --version 2>/dev/null");
- if (!defined $ver) {
- Log("NONE\n");
- return 0;
- }
- if (defined($opts{minversion})) {
- my $min = $opts{minversion};
- if (ver_norm($ver) lt ver_norm($min)) {
- Log("NO: version $ver is too old (need >= $min)\n");
- return 0;
- }
- }
- Log("YES: version $ver\n");
- Set("CONFIG_HAVE_$upper" => 1);
- Set("CONFIG_VER_$upper" => $ver);
-
- my $want = $opts{want};
- defined $want or $want = ["cflags", "libs"];
- for my $w (@$want) {
- my $uw = $w; $uw =~ tr/a-z-/A-Z_/;
- my $cf = TryCmd("$pc --$w");
- Set("${upper}_${uw}" => $cf) if defined $cf;
+ for my $wr (@atwrites) {
+ &$wr();
}
- return 1;
}
1; # OK
projects / libucw.git / blobdiff