UCW::Configure: Flush STDOUT after logging

[libucw.git] / ucw / perl / UCW / Configure.pm

diff --git a/ucw/perl/UCW/Configure.pm b/ucw/perl/UCW/Configure.pm
index 27e9a364422b1c712d0c572661a10dc2ec79f832..83b70e0d8fe722863b84979221b934d2ecedef85 100644 (file)
--- a/ucw/perl/UCW/Configure.pm
+++ b/ucw/perl/UCW/Configure.pm
@@ -1,6 +1,6 @@
 #      Perl module for UCW Configure Scripts
 #
-#      (c) 2005--2008 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.
@@ -16,7 +16,7 @@ BEGIN {
        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, &PostConfig, &AtWrite);
+       @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 = ();
 }
@@ -26,21 +26,24 @@ 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($) {
@@ -89,17 +92,34 @@ sub Override($;$) {
 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;
@@ -208,89 +228,4 @@ sub Finish() {
        }
 }
 
-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;
-       }
-       return 1;
-}
-
 1;  # OK