source4/script/pkg-config

   1 #!/usr/bin/perl
   2 # Simple pkg-config implementation in perl
   3 # jelmer@samba.org, November 2006
   4
   5 use strict;
   6 use Getopt::Long;
   7
   8 my @dirs = split(/:/, $ENV{PKG_CONFIG_PATH});
   9
  10 my $opt_help = 0;
  11 my $opt_libs = 0;
  12 my $opt_cflags = 0;
  13 my $opt_static = 0;
  14
  15 my $result = GetOptions (
  16             'help|h|?' => \$opt_help,
  17                 'static' => \$opt_static,
  18                 'libs' => \$opt_libs,
  19                 'cflags' => \$opt_cflags
  20             );
  21
  22 if (not $result) {
  23         exit(1);
  24 }
  25
  26 if ($opt_help) {
  27         print "pkg-config replacement in perl\n";
  28         print "Copyright (C) 2006 Jelmer Vernooij <jelmer\@samba.org>\n";
  29         print "\n";
  30         print "Usage: pkg-config [OPTIONS] PACKAGE...\n";
  31         print " --help                  Print this help message\n";
  32         print " --static                Print flags for static libraries\n";
  33         print " --libs                  Print linker flags\n";
  34         print " --cflags                Print C compiler flags\n";
  35         print "\n";
  36         exit(0);
  37 }
  38
  39 sub find_path($)
  40 {
  41         my $name = shift;
  42         foreach my $dir (@dirs) {
  43                 if (-f "$dir/$name-uninstalled.pc") {
  44                         return "$dir/$name-uninstalled.pc";
  45                 }
  46         }
  47         foreach my $dir (@dirs) {
  48                 if (-f "$dir/$name.pc" ) {
  49                         return "$dir/$name.pc";
  50                 }
  51         }
  52         die("No such package `$name'");
  53 }
  54
  55 sub ReplaceVars($$)
  56 {
  57         my ($expr, $vars) = @_;
  58
  59         $_ = $expr;
  60
  61         while (/(.*)\${([^}]+)}(.*)/) {
  62                 $_ = "$1$vars->{$2}$3";
  63         }
  64
  65         return $_;
  66 }
  67
  68 sub Parse($)
  69 {
  70         my $name = shift;
  71         my $path = find_path($name);
  72         my %variables = ();
  73         my %fields = ();
  74         my $lineno = 0;
  75         open(IN, "<$path") or die("Unable to open $path: $!");
  76         foreach (<IN>) {
  77                 $lineno+=1;
  78                 next if (/^#.*/);
  79                 if (/^([A-Za-z.]+): (.*)$/) {
  80                         $fields{$1} = ReplaceVars($2, \%variables);
  81                 } elsif (/^([A-Za-z_]+)=(.*)$/) {
  82                         $variables{$1} = ReplaceVars($2, \%variables);
  83                 } elsif (/^[ \t]*$/) {
  84                 } else {
  85                         warn("$path:$lineno: parse error");
  86                 }
  87         }
  88         close(IN);
  89         return \%fields;
  90 }
  91
  92 sub Cflags($)
  93 {
  94         my $name = shift;
  95         my $fields = Parse($name);
  96         my @cflags = split(/ /, $fields->{Cflags});
  97         foreach (split(/[, ]/, $fields->{Requires})) {
  98                 push (@cflags, Cflags($_));
  99         }
 100         return @cflags;
 101 }
 102
 103 sub Libs($)
 104 {
 105         my $name = shift;
 106         my $fields = Parse($name);
 107         my @libs = split(/ /, $fields->{Libs});
 108         foreach (split(/[, ]/, $fields->{Requires})) {
 109                 push (@libs, Libs($_));
 110         }
 111         if ($opt_static) {
 112                 foreach (split(/[ ,]/, $fields->{"Requires.private"})) {
 113                         push (@libs, Libs($_));
 114                 }
 115         }
 116         return @libs;
 117 }
 118
 119 my @out = ();
 120
 121 foreach my $pkg (@ARGV)
 122 {
 123         push (@out, Libs($pkg)) if ($opt_libs);
 124         push (@out, Cflags($pkg)) if ($opt_cflags);
 125 }
 126
 127 sub nub
 128 {
 129         my @list = @_;
 130         my @ret = ();
 131         my %seen = ();
 132         foreach (@list) {
 133                 next if (defined($seen{$_}));
 134                 push (@ret, $_);
 135                 $seen{$_} = 1;
 136         }
 137         return @ret;
 138 }
 139
 140 if ($#out >= 0) {
 141         @out = nub(@out);
 142         print join(' ', @out) . "\n";
 143 }
 144
 145 exit 0;