File Coverage

blib/lib/PkgConfig.pm
Criterion Covered Total %
statement 289 393 73.5
branch 50 102 49.0
condition 14 26 53.8
subroutine 50 57 87.7
pod 4 18 22.2
total 407 596 68.2


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             # lightweight no-dependency version of pkg-config. This will work on any machine
4             # with Perl installed.
5              
6             # Copyright (C) 2012 M. Nunberg.
7             # You may use and distribute this software under the same terms and conditions
8             # as Perl itself.
9              
10             package
11             PkgConfig::Vars;
12             # this is a namespace for .pc files to hold their variables without
13             # relying on lexical scope.
14              
15             package
16             PkgConfig::UDefs;
17             # This namespace provides user-defined variables which are to override any
18             # declarations within the .pc file itself.
19              
20             package PkgConfig;
21              
22             #First two digits are Perl version, second two are pkg-config version
23             our $VERSION = '0.24026';
24              
25             $VERSION =~ /([0-9]{2})$/;
26             my $compat_version = $1;
27              
28 10     10   343804 use strict;
  10         58  
  10         253  
29 10     10   44 use warnings;
  10         15  
  10         256  
30 10     10   195 use 5.006;
  10         28  
31 10     10   129 use Config;
  10         27  
  10         475  
32 10     10   61 use File::Spec;
  10         23  
  10         252  
33 10     10   54 use File::Glob 'bsd_glob';
  10         22  
  10         887  
34 10     10   4983 use Class::Struct; #in core since 5.004
  10         18508  
  10         48  
35 10     10   7335 use Data::Dumper;
  10         63426  
  10         634  
36 10     10   66 use File::Basename qw( dirname );
  10         19  
  10         764  
37 10     10   4572 use Text::ParseWords qw( shellwords );
  10         11296  
  10         1628  
38              
39             our $UseDebugging;
40              
41             ################################################################################
42             ### Check for Log::Fu ###
43             ################################################################################
44             BEGIN {
45 10     10   752 my $ret = eval q{
  10     10   1989  
  0         0  
  0         0  
46             use Log::Fu 0.25 { level => "warn" };
47             1;
48             };
49              
50 10 50       64 if(!$ret) {
51             my $log_base = sub {
52 0     0   0 my (@args) = @_;
53 0         0 print STDERR "[DEBUG] ", join(' ', @args);
54 0         0 print STDERR "\n";
55 10         46 };
56 10 50   236   50 *log_debug = *log_debugf = sub { return unless $UseDebugging; goto &$log_base };
  236         363  
  0         0  
57 10         16658 *log_err = *log_errf = *log_warn = *log_warnf = *log_info = *log_infof =
58             $log_base;
59              
60             }
61             }
62              
63             our $VarClassSerial = 0;
64              
65             ################################################################################
66             ### Sane Defaults ###
67             ################################################################################
68             our @DEFAULT_SEARCH_PATH = qw(
69             /usr/local/lib/pkgconfig /usr/local/share/pkgconfig
70             /usr/lib/pkgconfig /usr/share/pkgconfig
71              
72             );
73              
74             our @DEFAULT_EXCLUDE_CFLAGS = qw(-I/usr/include -I/usr/local/include);
75             # don't include default link/search paths!
76             our @DEFAULT_EXCLUDE_LFLAGS = map { ( "-L$_", "-R$_" ) } qw( /lib /lib32 /lib64 /usr/lib /usr/lib32 /usr/lib/64 /usr/local/lib /usr/local/lib32 /usr/local/lib64 );
77              
78             if($ENV{PKG_CONFIG_NO_OS_CUSTOMIZATION}) {
79              
80             # use the defaults regardless of detected platform
81              
82             } elsif($ENV{PKG_CONFIG_LIBDIR}) {
83              
84             @DEFAULT_SEARCH_PATH = split $Config{path_sep}, $ENV{PKG_CONFIG_LIBDIR};
85              
86             } elsif($^O eq 'msys') {
87              
88             # MSYS2 seems to actually set PKG_CONFIG_PATH in its /etc/profile
89             # god bless it. But. The defaults if you unset the environment
90             # variable are different
91             @DEFAULT_SEARCH_PATH = qw(
92             /usr/lib/pkgconfig
93             /usr/share/pkgconfig
94             );
95              
96             } elsif($^O eq 'solaris' && $Config{ptrsize} == 8) {
97              
98             @DEFAULT_SEARCH_PATH = qw(
99             /usr/local/lib/64/pkgconfig /usr/local/share/pkgconfig
100             /usr/lib/64/pkgconfig /usr/share/pkgconfig
101             );
102              
103             } elsif($^O eq 'linux' and -f '/etc/gentoo-release') {
104             # OK, we're running on Gentoo
105              
106             # Fetch ptrsize value
107             my $ptrsize = $Config{ptrsize};
108              
109             # Are we running on 64 bit system?
110             if ($ptrsize eq 8) {
111             # We do
112             @DEFAULT_SEARCH_PATH = qw!
113             /usr/lib64/pkgconfig/ /usr/share/pkgconfig/
114             !;
115             } else {
116             # We're running on a 32 bit system (hopefully)
117             @DEFAULT_SEARCH_PATH = qw!
118             /usr/lib/pkgconfig/ /usr/share/pkgconfig/
119             !;
120             }
121              
122             } elsif($^O =~ /^(gnukfreebsd|linux)$/ && -r "/etc/debian_version") {
123              
124             my $arch;
125             if(-x "/usr/bin/dpkg-architecture") {
126             # works if dpkg-dev is installed
127             # rt96694
128             ($arch) = map { chomp; (split /=/)[1] }
129             grep /^DEB_HOST_MULTIARCH=/,
130             `/usr/bin/dpkg-architecture`;
131             } elsif(-x "/usr/bin/gcc") {
132             # works if gcc is installed
133             $arch = `/usr/bin/gcc -dumpmachine`;
134             chomp $arch;
135             } else {
136             my $deb_arch = `dpkg --print-architecture`;
137             if($deb_arch =~ /^amd64/) {
138             if($^O eq 'linux') {
139             $arch = 'x86_64-linux-gnu';
140             } elsif($^O eq 'gnukfreebsd') {
141             $arch = 'x86_64-kfreebsd-gnu';
142             }
143             } elsif($deb_arch =~ /^i386/) {
144             if($^O eq 'linux') {
145             $arch = 'i386-linux-gnu';
146             } elsif($^O eq 'gnukfreebsd') {
147             $arch = 'i386-kfreebsd-gnu';
148             }
149             }
150             }
151              
152             if($arch) {
153             if(scalar grep /--print-foreign-architectures/, `dpkg --help`)
154             {
155             # multi arch support / Debian 7+
156             @DEFAULT_SEARCH_PATH = (
157             "/usr/local/lib/$arch/pkgconfig",
158             "/usr/local/lib/pkgconfig",
159             "/usr/local/share/pkgconfig",
160             "/usr/lib/$arch/pkgconfig",
161             "/usr/lib/pkgconfig",
162             "/usr/share/pkgconfig",
163             );
164              
165             push @DEFAULT_EXCLUDE_LFLAGS, map { ("-L$_", "-R$_") }
166             "/usr/local/lib/$arch",
167             "/usr/lib/$arch";
168              
169             } else {
170              
171             @DEFAULT_SEARCH_PATH = (
172             "/usr/local/lib/pkgconfig",
173             "/usr/local/lib/pkgconfig/$arch",
174             "/usr/local/share/pkgconfig",
175             "/usr/lib/pkgconfig",
176             "/usr/lib/pkgconfig/$arch",
177             "/usr/share/pkgconfig",
178             );
179             }
180              
181             } else {
182              
183             @DEFAULT_SEARCH_PATH = (
184             "/usr/local/lib/pkgconfig",
185             "/usr/local/share/pkgconfig",
186             "/usr/lib/pkgconfig",
187             "/usr/share/pkgconfig",
188             );
189              
190             }
191              
192             } elsif($^O eq 'linux' && -r "/etc/redhat-release") {
193              
194             if(-d "/usr/lib64/pkgconfig") {
195             @DEFAULT_SEARCH_PATH = qw(
196             /usr/lib64/pkgconfig
197             /usr/share/pkgconfig
198             );
199             } else {
200             @DEFAULT_SEARCH_PATH = qw(
201             /usr/lib/pkgconfig
202             /usr/share/pkgconfig
203             );
204             }
205              
206             } elsif($^O eq 'linux' && -r "/etc/slackware-version") {
207              
208             # Fetch ptrsize value
209             my $ptrsize = $Config{ptrsize};
210              
211             # Are we running on 64 bit system?
212             if ($ptrsize == 8) {
213             # We do
214             @DEFAULT_SEARCH_PATH = qw!
215             /usr/lib64/pkgconfig/ /usr/share/pkgconfig/
216             !;
217             } else {
218             # We're running on a 32 bit system (hopefully)
219             @DEFAULT_SEARCH_PATH = qw!
220             /usr/lib/pkgconfig/ /usr/share/pkgconfig/
221             !;
222             }
223              
224              
225             } elsif($^O eq 'freebsd') {
226              
227             # TODO: FreeBSD 10-12's version of pkg-config does not
228             # support PKG_CONFIG_DEBUG_SPEW so I can't verify
229             # the path there.
230             @DEFAULT_SEARCH_PATH = qw(
231             /usr/local/libdata/pkgconfig
232             /usr/libdata/pkgconfig
233             );
234              
235             } elsif($^O eq 'netbsd') {
236              
237             @DEFAULT_SEARCH_PATH = qw(
238             /usr/pkg/lib/pkgconfig
239             /usr/pkg/share/pkgconfig
240             /usr/X11R7/lib/pkgconfig
241             /usr/lib/pkgconfig
242             );
243             } elsif($^O eq 'openbsd') {
244              
245             @DEFAULT_SEARCH_PATH = qw(
246             /usr/lib/pkgconfig
247             /usr/local/lib/pkgconfig
248             /usr/local/share/pkgconfig
249             /usr/X11R6/lib/pkgconfig
250             /usr/X11R6/share/pkgconfig
251             );
252              
253             } elsif($^O eq 'MSWin32') {
254              
255             # Caveats:
256             # 1. This pulls in Config,
257             # which we don't load on non MSWin32
258             # but it is in the core.
259             # 2. Slight semantic difference in that we are treating
260             # Strawberry as the "system" rather than Windows, but
261             # since pkg-config is rarely used in MSWin32, it is
262             # better to have something that is useful rather than
263             # worry about if it is exactly the same as other
264             # platforms.
265             # 3. It is a little brittle in that Strawberry might
266             # one day change its layouts. If it has and you are
267             # reading this, please send a pull request or simply
268             # let me know -plicease
269             require Config;
270             if($Config::Config{myuname} =~ /strawberry-perl/)
271             {
272             # handle PAR::Packer executables which have $^X eq "perl.exe"
273             if ($ENV{PAR_0})
274             {
275             my $path = $ENV{PAR_TEMP};
276             $path =~ s{\\}{/}g;
277             @DEFAULT_SEARCH_PATH = ($path);
278             }
279             else {
280             my($vol, $dir, $file) = File::Spec->splitpath($^X);
281             my @dirs = File::Spec->splitdir($dir);
282             splice @dirs, -3;
283             my $path = (File::Spec->catdir($vol, @dirs, qw( c lib pkgconfig )));
284             $path =~ s{\\}{/}g;
285             @DEFAULT_SEARCH_PATH = $path;
286             }
287             }
288              
289             my @reg_paths;
290              
291             eval q{
292             package
293             PkgConfig::WinReg;
294              
295             use Win32API::Registry 0.21 qw( :ALL );
296              
297             foreach my $top (HKEY_LOCAL_MACHINE, HKEY_CURRENT_USER) {
298             my $key;
299             RegOpenKeyEx( $top, "Software\\\\pkgconfig\\\\PKG_CONFIG_PATH", 0, KEY_READ, $key) || next;
300             my $nlen = 1024;
301             my $pos = 0;
302             my $name = '';
303              
304             while(RegEnumValue($key, $pos++, $name, $nlen, [], [], [], [])) {
305             my $type;
306             my $data;
307             RegQueryValueEx($key, $name, [], $type, $data, []);
308             push @reg_paths, $data;
309             }
310              
311             RegCloseKey( $key );
312             }
313             };
314              
315             unless($@) {
316             unshift @DEFAULT_SEARCH_PATH, @reg_paths;
317             }
318              
319             if($Config::Config{cc} =~ /cl(\.exe)?$/i)
320             {
321             @DEFAULT_EXCLUDE_LFLAGS = ();
322             @DEFAULT_EXCLUDE_CFLAGS = ();
323             }
324             else
325             {
326             @DEFAULT_EXCLUDE_LFLAGS = (
327             "-L/mingw/lib",
328             "-R/mingw/lib",
329             "-L/mingw/lib/pkgconfig/../../lib",
330             "-R/mingw/lib/pkgconfig/../../lib",
331             );
332             @DEFAULT_EXCLUDE_CFLAGS = (
333             "-I/mingw/include",
334             "-I/mingw/lib/pkgconfig/../../include",
335             );
336             }
337              
338             # See caveats above for Strawberry and PAR::Packer
339             require Config;
340             if(not $ENV{PAR_0} and $Config::Config{myuname} =~ /strawberry-perl/)
341             {
342             my($vol, $dir, $file) = File::Spec->splitpath($^X);
343             my @dirs = File::Spec->splitdir($dir);
344             splice @dirs, -3;
345             my $path = (File::Spec->catdir($vol, @dirs, qw( c )));
346             $path =~ s{\\}{/}g;
347             push @DEFAULT_EXCLUDE_LFLAGS, (
348             "-L$path/lib",
349             "-L$path/lib/pkgconfig/../../lib",
350             "-R$path/lib",
351             "-R$path/lib/pkgconfig/../../lib",
352             );
353             push @DEFAULT_EXCLUDE_CFLAGS, (
354             "-I$path/include",
355             "-I$path/lib/pkgconfig/../../include",
356             );
357             }
358             } elsif($^O eq 'darwin') {
359              
360             if(-x '/usr/local/Homebrew/bin/brew') {
361             # Mac OS X with homebrew installed
362             push @DEFAULT_SEARCH_PATH,
363             bsd_glob '/usr/local/opt/*/lib/pkgconfig'
364             ;
365             }
366              
367             }
368              
369             my @ENV_SEARCH_PATH = split($Config{path_sep}, $ENV{PKG_CONFIG_PATH} || "");
370              
371             unshift @DEFAULT_SEARCH_PATH, @ENV_SEARCH_PATH;
372              
373             if($^O eq 'MSWin32') {
374             @DEFAULT_SEARCH_PATH = map { s{\\}{/}g; $_ } map { /\s/ ? Win32::GetShortPathName($_) : $_ } @DEFAULT_SEARCH_PATH;
375             }
376              
377             if($ENV{PKG_CONFIG_ALLOW_SYSTEM_CFLAGS}) {
378             @DEFAULT_EXCLUDE_CFLAGS = ();
379             }
380              
381             if($ENV{PKG_CONFIG_ALLOW_SYSTEM_LIBS}) {
382             @DEFAULT_EXCLUDE_LFLAGS = ();
383             }
384              
385             my $LD_OUTPUT_RE = qr/
386             SEARCH_DIR\("
387             ([^"]+)
388             "\)
389             /x;
390              
391             sub GuessPaths {
392 0     0 0 0 my $pkg = shift;
393 0         0 local $ENV{LD_LIBRARY_PATH} = "";
394 0         0 local $ENV{C_INCLUDE_PATH} = "";
395 0         0 local $ENV{LD_RUN_PATH} = "";
396              
397 0   0     0 my $ld = $ENV{LD} || 'ld';
398 0         0 my $ld_output = qx(ld -verbose);
399 0         0 my @defl_search_dirs = ($ld_output =~ m/$LD_OUTPUT_RE/g);
400              
401 0         0 @DEFAULT_EXCLUDE_LFLAGS = ();
402 0         0 foreach my $path (@defl_search_dirs) {
403 0         0 push @DEFAULT_EXCLUDE_LFLAGS, (map { "$_".$path }
  0         0  
404             (qw(-R -L -rpath= -rpath-link= -rpath -rpath-link)));
405             }
406 0         0 log_debug("Determined exclude LDFLAGS", @DEFAULT_EXCLUDE_LFLAGS);
407              
408             #now get the include paths:
409 0         0 my @cpp_output = qx(cpp --verbose 2>&1 < /dev/null);
410 0         0 @cpp_output = map { chomp $_; $_ } @cpp_output;
  0         0  
  0         0  
411             #log_info(join("!", @cpp_output));
412 0         0 while (my $cpp_line = shift @cpp_output) {
413 0         0 chomp($cpp_line);
414 0 0       0 if($cpp_line =~ /\s*#include\s*<.+search starts here/) {
415 0         0 last;
416             }
417             }
418             #log_info(@cpp_output);
419 0         0 my @include_paths;
420 0         0 while (my $path = shift @cpp_output) {
421 0 0       0 if($path =~ /\s*End of search list/) {
422 0         0 last;
423             }
424 0         0 push @include_paths, $path;
425             }
426 0         0 @DEFAULT_EXCLUDE_CFLAGS = map { "-I$_" } @include_paths;
  0         0  
427 0         0 log_debug("Determine exclude CFLAGS", @DEFAULT_EXCLUDE_CFLAGS);
428             }
429              
430              
431             ################################################################################
432             ### Define our fields ###
433             ################################################################################
434             struct(
435             __PACKAGE__,
436             [
437             # .pc search paths, defaults to PKG_CONFIG_PATH in environment
438             'search_path' => '@',
439              
440             # whether to also spit out static dependencies
441             'static' => '$',
442              
443             # whether we replace references to -L and friends with -Wl,-rpath, etc.
444             'rpath' => '$',
445              
446             # build rpath-search,
447              
448             # no recursion. set if we just want a version, or to see if the
449             # package exists.
450             'no_recurse' => '$',
451              
452             #list of cflags and ldflags to exclude
453             'exclude_ldflags' => '@',
454             'exclude_cflags' => '@',
455              
456             # what level of recursion we're at
457             'recursion' => '$',
458              
459             # hash of libraries, keyed by recursion levels. Lower recursion numbers
460             # will be listed first
461             'libs_deplist' => '*%',
462              
463             # cumulative cflags and ldflags
464             'ldflags' => '*@',
465             'cflags' => '*@',
466              
467             # whether we print the c/ldflags
468             'print_cflags' => '$',
469             'print_ldflags' => '$',
470              
471             # information about our top-level package
472             'pkg' => '$',
473             'pkg_exists' => '$',
474             'pkg_version' => '$',
475             'pkg_url', => '$',
476             'pkg_description' => '$',
477             'errmsg' => '$',
478              
479             # classes used for storing persistent data
480             'varclass' => '$',
481             'udefclass' => '$',
482             'filevars' => '*%',
483             'uservars' => '*%',
484              
485             # options for printing variables
486             'print_variables' => '$',
487             'print_variable' => '$',
488             'print_values' => '$',
489             'defined_variables' => '*%',
490              
491             # for creating PkgConfig objects with identical
492             # settings
493             'original' => '$',
494             ]
495             );
496              
497             ################################################################################
498             ################################################################################
499             ### Variable Storage ###
500             ################################################################################
501             ################################################################################
502              
503             sub _get_pc_varname {
504 197     197   274 my ($self,$vname_base) = @_;
505 197         2251 $self->varclass . "::" . $vname_base;
506             }
507              
508             sub _get_pc_udefname {
509 0     0   0 my ($self,$vname_base) = @_;
510 0         0 $self->udefclass . "::" . $vname_base;
511             }
512              
513             sub _pc_var {
514 79     79   127 my ($self,$vname) = @_;
515 79         122 $vname =~ s,\.,DOT,g;
516 10     10   73 no strict 'refs';
  10         85  
  10         482  
517 79         115 $vname = $self->_get_pc_varname($vname);
518 10     10   61 no warnings qw(once);
  10         15  
  10         1604  
519 79         496 my $glob = *{$vname};
  79         259  
520 79 50       613 $glob ? $$glob : ();
521             }
522              
523             sub _quote_cvt($) {
524 118     118   325 join ' ', map { s/(\s|"|')/\\$1/g; $_ } shellwords(shift)
  176         7624  
  176         933  
525             }
526              
527             sub assign_var {
528 118     118 0 196 my ($self,$field,$value) = @_;
529 10     10   64 no strict 'refs';
  10         14  
  10         908  
530              
531             # if the user has provided a definition, use that.
532 118 50       119 if(exists ${$self->udefclass."::"}{$field}) {
  118         1384  
533 0         0 log_debug("Prefix already defined by user");
534 0         0 return;
535             }
536 118         952 my $evalstr = sprintf('$%s = PkgConfig::_quote_cvt(%s)',
537             $self->_get_pc_varname($field), $value);
538              
539 118         972 log_debug("EVAL", $evalstr);
540 118         118 do {
541 10     10   75 no warnings 'uninitialized';
  10         23  
  10         918  
542 118         5487 eval $evalstr;
543             };
544 118 50       873 if($@) {
545 0         0 log_err($@);
546             }
547             }
548              
549             sub prepare_vars {
550 11     11 0 22 my $self = shift;
551 11         214 my $varclass = $self->varclass;
552 10     10   61 no strict 'refs';
  10         17  
  10         3017  
553              
554 11         74 %{$varclass . "::"} = ();
  11         72  
555              
556 11         20 while (my ($name,$glob) = each %{$self->udefclass."::"}) {
  11         147  
557 0         0 my $ref = *$glob{SCALAR};
558 0 0       0 next unless defined $ref;
559 0         0 ${"$varclass\::$name"} = $$ref;
  0         0  
560             }
561             }
562              
563             ################################################################################
564             ################################################################################
565             ### Initializer ###
566             ################################################################################
567             ################################################################################
568             sub find {
569 13     13 1 19566 my ($cls,$library,%options) = @_;
570 13         64 my @uspecs = (
571             ['search_path', \@DEFAULT_SEARCH_PATH],
572             ['exclude_ldflags', \@DEFAULT_EXCLUDE_LFLAGS],
573             ['exclude_cflags', \@DEFAULT_EXCLUDE_CFLAGS]
574             );
575              
576 13         35 my %original = %options;
577              
578 13         31 foreach (@uspecs) {
579 39         81 my ($basekey,$default) = @$_;
580 39   100     45 my $list = [ @{$options{$basekey} ||= [] } ];
  39         167  
581 39 50       89 if($options{$basekey . "_override"}) {
582 0         0 @$list = @{ delete $options{$basekey."_override"} };
  0         0  
583             } else {
584 39         170 push @$list, @$default;
585             }
586              
587 39         91 $options{$basekey} = $list;
588             #print "$basekey: " . Dumper($list);
589             }
590              
591 13         19 $VarClassSerial++;
592 13         56 $options{varclass} = sprintf("PkgConfig::Vars::SERIAL_%d", $VarClassSerial);
593 13         32 $options{udefclass} = sprintf("PkgConfig::UDefs::SERIAL_%d", $VarClassSerial);
594 13         32 $options{original} = \%original;
595              
596              
597 13   50     84 my $udefs = delete $options{VARS} || {};
598              
599 13         51 while (my ($k,$v) = each %$udefs) {
600 10     10   64 no strict 'refs';
  10         17  
  10         8357  
601 0         0 my $vname = join('::', $options{udefclass}, $k);
602 0         0 ${$vname} = $v;
  0         0  
603             }
604              
605 13         292 my $o = $cls->new(%options);
606              
607 13         2570 my @libraries;
608 13 50       41 if(ref $library eq 'ARRAY') {
609 0         0 @libraries = @$library;
610             } else {
611 13         29 @libraries = ($library);
612             }
613              
614 13 100       26 if($options{file_path}) {
615              
616 2 100       35 if(-r $options{file_path}) {
617 1         24 $o->recursion(1);
618 1         15 $o->parse_pcfile($options{file_path});
619 1         13 $o->recursion(0);
620             } else {
621 1         29 $o->errmsg("No such file $options{file_path}\n");
622             }
623              
624             } else {
625              
626 11         24 foreach my $lib (@libraries) {
627 11         186 $o->recursion(0);
628 11         68 my($op,$ver);
629 11 50       50 ($lib,$op,$ver) = ($1,$2,PkgConfig::Version->new($3))
630             if $lib =~ /^(.*)\s+(!=|=|>=|<=|>|<)\s+(.*)$/;
631 11         60 $o->find_pcfile($lib);
632              
633 11 50 66     236 if(!$o->errmsg && defined $op) {
634 0 0       0 $op = '==' if $op eq '=';
635 0 0       0 unless(eval qq{ PkgConfig::Version->new(\$o->pkg_version) $op \$ver })
636             {
637 0 0       0 $o->errmsg("Requested '$lib $op $ver' but version of $lib is " .
638             ($o->pkg_version ? $o->pkg_version : '') . "\n");
639             }
640             }
641             }
642             }
643              
644 13         192 $o;
645             }
646              
647             ################################################################################
648             ################################################################################
649             ### Modify our flags stack ###
650             ################################################################################
651             ################################################################################
652             sub append_ldflags {
653 12     12 0 25 my ($self,@flags) = @_;
654 12         25 my @ld_flags = _split_flags(@flags);
655              
656 12         47 foreach my $ldflag (@ld_flags) {
657 26 50       51 next unless $ldflag =~ /^-Wl/;
658              
659 0         0 my (@wlflags) = split(/,/, $ldflag);
660 0         0 shift @wlflags; #first is -Wl,
661 0         0 filter_omit(\@wlflags, $self->exclude_ldflags);
662              
663 0 0       0 if(!@wlflags) {
664 0         0 $ldflag = "";
665 0         0 next;
666             }
667              
668 0         0 $ldflag = join(",", '-Wl', @wlflags);
669             }
670              
671 12         35 @ld_flags = grep $_, @ld_flags;
672 12 100       24 return unless @ld_flags;
673              
674 11   100     16 push @{($self->libs_deplist->{$self->recursion} ||=[])},
  11         156  
675             @ld_flags;
676             }
677              
678             # notify us about extra compiler flags
679             sub append_cflags {
680 12     12 0 23 my ($self,@flags) = @_;
681 12         16 push @{$self->cflags}, _split_flags(@flags);
  12         154  
682             }
683              
684              
685             ################################################################################
686             ################################################################################
687             ### All sorts of parsing is here ###
688             ################################################################################
689             ################################################################################
690             sub get_requires {
691 22     22 0 49 my ($self,$requires) = @_;
692 22 100       49 return () unless $requires;
693              
694 2         7 my @reqlist = split(/[\s,]+/, $requires);
695 2         3 my @ret;
696 2         5 while (defined (my $req = shift @reqlist) ) {
697 2         5 my $reqlet = [ $req ];
698 2         2 push @ret, $reqlet;
699 2 50       7 last unless @reqlist;
700             #check if we need some version scanning:
701              
702 0         0 my $cmp_op;
703             my $want;
704              
705             GT_PARSE_REQ:
706             {
707             #all in one word:
708 0         0 ($cmp_op) = ($req =~ /([<>=]+)/);
  0         0  
709 0 0       0 if($cmp_op) {
    0          
710 0 0       0 if($req =~ /[<>=]+$/) {
711 0         0 log_debug("comparison operator spaced ($cmp_op)");
712 0         0 ($want) = ($req =~ /([^<>=]+$)/);
713 0   0     0 $want ||= shift @reqlist;
714             } else {
715 0         0 $want = shift @reqlist;
716             }
717 0         0 push @$reqlet, ($cmp_op, $want);
718             } elsif ($reqlist[0] =~ /[<>=]+/) {
719 0         0 $req = shift @reqlist;
720 0         0 goto GT_PARSE_REQ;
721             }
722             }
723             }
724             #log_debug(@ret);
725 2         5 @ret;
726             }
727              
728              
729             sub parse_line {
730 129     129 0 210 my ($self,$line,$evals) = @_;
731 10     10   69 no strict 'vars';
  10         23  
  10         19543  
732              
733 129         210 $line =~ s/#[^#]+$//g; # strip comments
734 129 100       198 return unless $line;
735              
736 118         373 my ($tok) = ($line =~ /([=:])/);
737              
738 118         338 my ($field,$value) = split(/[=:]/, $line, 2);
739 118 50       203 return unless defined $value;
740              
741 118 100       340 if($tok eq '=') {
742 56         891 $self->defined_variables->{$field} = $value;
743             }
744              
745             #strip trailing/leading whitespace:
746 118         701 $field =~ s/(^\s+)|(\s+)$//msg;
747              
748             #remove trailing/leading whitespace from value
749 118         578 $value =~ s/(^\s+)|(\s+$)//msg;
750              
751 118         250 log_debugf("Field %s, Value %s", $field, $value);
752              
753 118         168 $field = lc($field);
754              
755             #perl variables can't have '.' in them:
756 118         151 $field =~ s/\./DOT/g;
757              
758             #remove quotes from field names
759 118         161 $field =~ s/['"]//g;
760              
761              
762             # pkg-config escapes a '$' with a '$$'. This won't go in perl:
763 118         167 $value =~ s/[^\\]\$\$/\\\$/g;
764 118         173 $value =~ s/([@%&])/\$1/g;
765              
766              
767             # append our pseudo-package for persistence.
768 118         1634 my $varclass = $self->varclass;
769 118         841 $value =~ s/(\$\{[^}]+\})/lc($1)/ge;
  49         149  
770              
771 118         249 $value =~ s/\$\{/\$\{$varclass\::/g;
772              
773             # preserve quoted space
774 118 100       257 $value = join ' ', map { s/(["'])/\\$1/g; "'$_'" } shellwords $value
  10         448  
  10         28  
775             if $value =~ /[\\"']/;
776              
777             #quote the value string, unless quoted already
778 118         199 $value = "\"$value\"";
779              
780             #get existent variables from our hash:
781              
782              
783             #$value =~ s/'/"/g; #allow for interpolation
784 118         206 $self->assign_var($field, $value);
785              
786             }
787              
788             sub parse_pcfile {
789 11     11 0 26 my ($self,$pcfile,$wantversion) = @_;
790             #log_warn("Requesting $pcfile");
791 11 50       493 open my $fh, "<", $pcfile or die "$pcfile: $!";
792              
793 11         61 $self->prepare_vars();
794              
795 11         400 my @lines = (<$fh>);
796 11         102 close($fh);
797              
798 11         50 my $text = join("", @lines);
799 11         33 $text =~ s,\\[\r\n],,g;
800 11         86 @lines = split(/[\r\n]/, $text);
801              
802 11         18 my @eval_strings;
803              
804             #Fold lines:
805              
806 11         567 my $pcfiledir = dirname $pcfile;
807 11         27 $pcfiledir =~ s{\\}{/}g;
808              
809 11         41 foreach my $line ("pcfiledir=$pcfiledir", @lines) {
810 129         329 $self->parse_line($line, \@eval_strings);
811             }
812              
813             #now that we have eval strings, evaluate them all within the same
814             #lexical scope:
815              
816              
817 11         30 $self->append_cflags( $self->_pc_var('cflags') );
818 11 50       159 if($self->static) {
819 0         0 $self->append_cflags( $self->_pc_var('cflags.private') );
820             }
821 11         84 $self->append_ldflags( $self->_pc_var('libs') );
822 11 50       304 if($self->static) {
823 0         0 $self->append_ldflags( $self->_pc_var('libs.private') );
824             }
825              
826 11         69 my @deps;
827 11         26 my @deps_dynamic = $self->get_requires( $self->_pc_var('requires'));
828 11         23 my @deps_static = $self->get_requires( $self->_pc_var('requires.private') );
829 11         25 @deps = @deps_dynamic;
830              
831              
832 11 50       140 if($self->static) {
833 0         0 push @deps, @deps_static;
834             }
835              
836 11 50 33     186 if($self->recursion == 1 && (!$self->pkg_exists())) {
837 11         317 $self->pkg_version( $self->_pc_var('version') );
838 11         69 $self->pkg_url( $self->_pc_var('url') );
839 11         79 $self->pkg_description( $self->_pc_var('description') );
840 11         164 $self->pkg_exists(1);
841             }
842              
843 11 50       180 unless ($self->no_recurse) {
844 11         101 foreach (@deps) {
845 2         11 my ($dep,$cmp_op,$version) = @$_;
846 2 50       5 $dep = "$dep $cmp_op $version" if defined $cmp_op;
847 2         3 my $other = PkgConfig->find($dep, %{ $self->original });
  2         27  
848 2 100       29 if($other->errmsg) {
849 1         16 $self->errmsg($other->errmsg);
850 1         15 last;
851             }
852 1         8 $self->append_cflags( $other->get_cflags );
853 1         3 $self->append_ldflags( $other->get_ldflags );
854             }
855             }
856             }
857              
858              
859             ################################################################################
860             ################################################################################
861             ### Locate and process a .pc file ###
862             ################################################################################
863             ################################################################################
864             sub find_pcfile {
865 11     11 0 25 my ($self,$libname,$version) = @_;
866              
867 11         162 $self->recursion($self->recursion + 1);
868              
869 11         112 my $pcfile = "$libname.pc";
870 11         16 my $found = 0;
871             my @found_paths = (grep {
872 77         1480 -e File::Spec->catfile($_, $pcfile)
873 11         15 } @{$self->search_path});
  11         134  
874              
875 11 100       40 if(!@found_paths) {
876 1         2 my @search_paths = @{$self->search_path};
  1         18  
877 1 50       19 $self->errmsg(
878             join("\n",
879             "Can't find $pcfile in any of @search_paths",
880             "use the PKG_CONFIG_PATH environment variable, or",
881             "specify extra search paths via 'search_paths'",
882             ""
883             )
884             ) unless $self->errmsg();
885 1         29 return;
886             }
887              
888 10         70 $pcfile = File::Spec->catfile($found_paths[0], $pcfile);
889              
890 10         51 $self->parse_pcfile($pcfile);
891              
892 10         158 $self->recursion($self->recursion - 1);
893             }
894              
895             ################################################################################
896             ################################################################################
897             ### Public Getters ###
898             ################################################################################
899             ################################################################################
900              
901             sub _return_context (@) {
902 18 100   18   106 wantarray ? (@_) : join(' ', map { s/(\s|['"])/\\$1/g; $_ } @_)
  12         54  
  12         43  
903             }
904              
905             sub get_cflags {
906 15     15 1 4907 my $self = shift;
907 15         21 my @cflags = @{$self->cflags};
  15         268  
908              
909 15         263 filter_omit(\@cflags, $self->exclude_cflags);
910 15         35 filter_dups(\@cflags);
911 15         25 _return_context @cflags;
912             }
913              
914             sub get_ldflags {
915 3     3 1 6 my $self = shift;
916 3         5 my @ordered_libs;
917 3         5 my @lib_levels = sort keys %{$self->libs_deplist};
  3         65  
918 3         25 my @ret;
919              
920 3         4 @ordered_libs = @{$self->libs_deplist}{@lib_levels};
  3         45  
921 3         26 foreach my $liblist (@ordered_libs) {
922 3         10 my $lcopy = [ @$liblist ];
923 3         8 filter_dups($lcopy);
924 3         43 filter_omit($lcopy, $self->exclude_ldflags);
925 3         11 push @ret, @$lcopy;
926             }
927              
928 3         4 @ret = reverse @ret;
929 3         8 filter_dups(\@ret);
930 3         3 @ret = reverse(@ret);
931 3         8 _return_context @ret;
932             }
933              
934             sub get_var {
935 2     2 1 1503 my($self, $name) = @_;
936 2         7 $self->_pc_var($name);
937             }
938              
939             sub get_list {
940 0     0 0 0 my $self = shift;
941 0         0 my @search_paths = @{$self->search_path};
  0         0  
942 0         0 my @rv = ();
943 0         0 $self->recursion(0);
944 0         0 for my $d (@search_paths) {
945 0 0       0 next unless -d $d;
946 0         0 for my $pc (bsd_glob("$d/*.pc")) {
947 0 0       0 if ($pc =~ m|/([^\\\/]+)\.pc$|) {
948 0         0 $self->parse_pcfile($pc);
949 0         0 push @rv, [$1, $self->_pc_var('name') . ' - ' . $self->_pc_var('description')];
950             }
951             }
952             }
953 0         0 @rv;
954             }
955              
956              
957             ################################################################################
958             ################################################################################
959             ### Utility functions ###
960             ################################################################################
961             ################################################################################
962              
963             #split a list of tokens by spaces
964             sub _split_flags {
965 24     24   107 my @flags = @_;
966 24 50       46 if(!@flags) {
967 0         0 return @flags;
968             }
969 24 100       50 if(@flags == 1) {
970 23         33 my $str = shift @flags;
971 23 100       39 return () if !$str;
972             #@flags = map { s/\\(\s)/$1/g; $_ } split(/(?
973 21         45 @flags = shellwords $str;
974             }
975 22         1314 @flags = grep $_, @flags;
976 22         44 @flags;
977             }
978              
979              
980              
981             sub filter_dups {
982 21     21 0 38 my $array = shift;
983 21         27 my @ret;
984             my %seen_hash;
985             #@$array = reverse @$array;
986 21         40 foreach my $elem (@$array) {
987 59 50       87 if(exists $seen_hash{$elem}) {
988 0         0 next;
989             }
990 59         88 $seen_hash{$elem} = 1;
991 59         85 push @ret, $elem;
992             }
993             #print Dumper(\%seen_hash);
994 21         56 @$array = @ret;
995             }
996              
997             sub filter_omit {
998 18     18 0 115 my ($have,$exclude) = @_;
999 18         22 my @ret;
1000             #print Dumper($have);
1001 18         28 foreach my $elem (@$have) {
1002             #log_warn("Checking '$elem'");
1003 44 50       60 if(grep { $_ eq $elem } @$exclude) {
  388         499  
1004             #log_warn("Found illegal flag '$elem'");
1005 0         0 next;
1006             }
1007 44         70 push @ret, $elem;
1008             }
1009 18         41 @$have = @ret;
1010             }
1011              
1012             sub version_2_array {
1013 0     0 0 0 my $string = shift;
1014 0         0 my @chunks = split(/\./, $string);
1015 0         0 my @ret;
1016             my $chunk;
1017 0   0     0 while( ($chunk = pop @chunks)
1018             && $chunk =~ /^\d+$/) {
1019 0         0 push @ret, $chunk;
1020             }
1021 0         0 @ret;
1022             }
1023              
1024              
1025             sub version_check {
1026 0     0 0 0 my ($want,$have) = @_;
1027 0         0 my @a_want = version_2_array($want);
1028 0         0 my @a_have = version_2_array($have);
1029              
1030 0 0       0 my $max_elem = scalar @a_want > scalar @a_have
1031             ? scalar @a_have
1032             : scalar @a_want;
1033              
1034 0         0 for(my $i = 0; $i < $max_elem; $i++) {
1035 0 0       0 if($a_want[$i] > $a_have[$i]) {
1036 0         0 return 0;
1037             }
1038             }
1039 0         0 1;
1040             }
1041              
1042              
1043             if(caller) {
1044             return 1;
1045             }
1046              
1047             package
1048             PkgConfig::Version;
1049              
1050             use overload
1051 8     8   19 '<=>' => sub { $_[0]->cmp($_[1]) },
1052 0     0   0 '""' => sub { $_[0]->as_string },
1053 10     10   6632 fallback => 1;
  10         5040  
  10         92  
1054              
1055             sub new {
1056 6     6   87 my($class, $value) = @_;
1057 6 50       31 bless [split /\./, defined $value ? $value : ''], $class;
1058             }
1059              
1060             sub clone {
1061 3     3   11 __PACKAGE__->new(shift->as_string);
1062             }
1063              
1064             sub as_string {
1065 3     3   4 my($self) = @_;
1066 3         5 join '.', @{ $self };
  3         29  
1067             }
1068              
1069             sub cmp {
1070 32     32   40 my($self, $other) = @_;
1071 10     10   2080 no warnings 'uninitialized';
  10         22  
  10         1121  
1072 32 100 100     157 defined($self->[0]) || defined($other->[0]) ? ($self->[0] <=> $other->[0]) || &cmp([@{$self}[1..$#$self]], [@{$other}[1..$#$other]]) : 0;
      100        
1073             }
1074              
1075             ################################################################################
1076             ################################################################################
1077             ################################################################################
1078             ################################################################################
1079             ### Script-Only stuff ###
1080             ################################################################################
1081             ################################################################################
1082             ################################################################################
1083             ################################################################################
1084             package PkgConfig::Script;
1085 10     10   61 use strict;
  10         22  
  10         345  
1086 10     10   56 use warnings;
  10         13  
  10         366  
1087 10     10   6998 use Getopt::Long qw(:config no_ignore_case);
  10         93570  
  10         41  
1088 10     10   6907 use Pod::Usage;
  10         425055  
  10         12436  
1089              
1090             my $quiet_errors = 1;
1091             my @ARGV_PRESERVE = @ARGV;
1092              
1093             my @POD_USAGE_SECTIONS = (
1094             "NAME",
1095             'DESCRIPTION/SCRIPT OPTIONS/USAGE',
1096             "DESCRIPTION/SCRIPT OPTIONS/ARGUMENTS|ENVIRONMENT",
1097             "AUTHOR & COPYRIGHT"
1098             );
1099              
1100             my @POD_USAGE_OPTIONS = (
1101             -verbose => 99,
1102             -sections => \@POD_USAGE_SECTIONS
1103             );
1104              
1105             GetOptions(
1106             'libs' => \my $PrintLibs,
1107             'libs-only-L' => \my $PrintLibsOnlyL,
1108             'libs-only-l' => \my $PrintLibsOnlyl,
1109             'libs-only-other' => \my $PrintLibsOnlyOther,
1110             'list-all' => \my $ListAll,
1111             'static' => \my $UseStatic,
1112             'cflags' => \my $PrintCflags,
1113             'cflags-only-I' => \my $PrintCflagsOnlyI,
1114             'cflags-only-other' => \my $PrintCflagsOnlyOther,
1115             'exists' => \my $PrintExists,
1116             'atleast-version=s' => \my $AtLeastVersion,
1117             'atleast-pkgconfig-version=s' => \my $AtLeastPkgConfigVersion,
1118             'exact-version=s' => \my $ExactVersion,
1119             'max-version=s' => \my $MaxVersion,
1120              
1121             'silence-errors' => \my $SilenceErrors,
1122             'print-errors' => \my $PrintErrors,
1123             'errors-to-stdout' => \my $ErrToStdOut,
1124             'short-errors' => \my $ShortErrors,
1125              
1126             'define-variable=s', => \my %UserVariables,
1127              
1128             'print-variables' => \my $PrintVariables,
1129             'print-values' => \my $PrintValues,
1130             'variable=s', => \my $OutputVariableValue,
1131              
1132             'modversion' => \my $PrintVersion,
1133             'version', => \my $PrintAPIversion,
1134             'real-version' => \my $PrintRealVersion,
1135              
1136             'debug' => \my $Debug,
1137             'with-path=s', => \my @ExtraPaths,
1138             'env-only', => \my $EnvOnly,
1139             'guess-paths', => \my $GuessPaths,
1140              
1141             'h|help|?' => \my $WantHelp
1142             ) or pod2usage(@POD_USAGE_OPTIONS);
1143              
1144             if($^O eq 'msys' && !$ENV{PKG_CONFIG_NO_OS_CUSTOMIZATION}) {
1145             $UseStatic = 1;
1146             }
1147              
1148             if($WantHelp) {
1149             pod2usage(@POD_USAGE_OPTIONS, -exitval => 0);
1150             }
1151              
1152             if($Debug) {
1153             eval {
1154             Log::Fu::set_log_level('PkgConfig', 'DEBUG');
1155             };
1156             $PkgConfig::UseDebugging = 1;
1157             }
1158              
1159             if($GuessPaths) {
1160             PkgConfig->GuessPaths();
1161             }
1162              
1163             if($PrintAPIversion) {
1164             print '0.', $compat_version, "\n";
1165             exit(0);
1166             }
1167              
1168             if($AtLeastPkgConfigVersion) {
1169             my($major,$minor,$patch) = split /\./, $AtLeastPkgConfigVersion;
1170             exit 1 if $major > 0;
1171             exit 1 if $minor > $compat_version;
1172             exit 1 if $minor == $compat_version && $patch > 0;
1173             exit 0;
1174             }
1175              
1176             if($PrintRealVersion) {
1177              
1178             printf STDOUT ("ppkg-config - cruftless pkg-config\n" .
1179             "Version: %s\n", $PkgConfig::VERSION);
1180             exit(0);
1181             }
1182              
1183             if($PrintErrors) {
1184             $quiet_errors = 0;
1185             }
1186              
1187             if($SilenceErrors) {
1188             $quiet_errors = 1;
1189             }
1190              
1191             # This option takes precedence over all other options
1192             # be it:
1193             # --silence-errors
1194             # or
1195             # --print-errors
1196             if ($ErrToStdOut) {
1197             $quiet_errors = 2;
1198             }
1199              
1200             my $WantFlags = ($PrintCflags || $PrintLibs || $PrintLibsOnlyL || $PrintCflagsOnlyI || $PrintCflagsOnlyOther || $PrintLibsOnlyOther || $PrintLibsOnlyl || $PrintVersion);
1201              
1202             if($WantFlags) {
1203             $quiet_errors = 0 unless $SilenceErrors;
1204             }
1205              
1206             my %pc_options;
1207             if($PrintExists || $AtLeastVersion || $ExactVersion || $MaxVersion || $PrintVersion) {
1208             $pc_options{no_recurse} = 1;
1209             }
1210              
1211              
1212             $pc_options{static} = $UseStatic;
1213             $pc_options{search_path} = \@ExtraPaths;
1214              
1215             if($EnvOnly) {
1216             delete $pc_options{search_path};
1217             $pc_options{search_path_override} = [ @ExtraPaths, @ENV_SEARCH_PATH];
1218             }
1219              
1220             $pc_options{print_variables} = $PrintVariables;
1221             $pc_options{print_values} = $PrintValues;
1222             $pc_options{VARS} = \%UserVariables;
1223              
1224             if($ListAll) {
1225             my $o = PkgConfig->find([], %pc_options);
1226             my @list = $o->get_list();
1227              
1228             # can't use List::Util::max as it wasn't core until Perl 5.8
1229             my $max_length = 0;
1230             foreach my $length (map { length $_->[0] } @list) {
1231             $max_length = $length if $length > $max_length;
1232             }
1233              
1234             printf "%-${max_length}s %s\n", $_->[0], $_->[1] for @list;
1235             exit(0);
1236             }
1237              
1238             my @FINDLIBS = @ARGV or die "Must specify at least one library";
1239              
1240             if($AtLeastVersion) {
1241             @FINDLIBS = map { "$_ >= $AtLeastVersion" } @FINDLIBS;
1242             } elsif($MaxVersion) {
1243             @FINDLIBS = map { "$_ <= $MaxVersion" } @FINDLIBS;
1244             } elsif($ExactVersion) {
1245             @FINDLIBS = map { "$_ = $ExactVersion" } @FINDLIBS;
1246             }
1247              
1248             my $o = PkgConfig->find(\@FINDLIBS, %pc_options);
1249              
1250             if($o->errmsg) {
1251             # --errors-to-stdout
1252             if ($quiet_errors eq 2) {
1253             print STDOUT $o->errmsg;
1254             # --print-errors
1255             } elsif ($quiet_errors eq 1) {
1256             print STDERR $o->errmsg;
1257             }
1258             # --silence-errors
1259             exit(1);
1260             }
1261              
1262             if($o->print_variables) {
1263             while (my ($k,$v) = each %{$o->defined_variables}) {
1264             print $k;
1265             if($o->print_values) {
1266             print "=$v";
1267             } else {
1268             print "\n";
1269             }
1270             }
1271             }
1272              
1273             if($OutputVariableValue) {
1274             my $val = ($o->_pc_var($OutputVariableValue) or "");
1275             print $val . "\n";
1276             }
1277              
1278             if(!$WantFlags) {
1279             exit(0);
1280             }
1281              
1282             if($PrintVersion) {
1283             print $o->pkg_version . "\n";
1284             exit(0);
1285             }
1286              
1287             my @print_flags;
1288              
1289             if($PrintCflags) {
1290             @print_flags = $o->get_cflags;
1291             }
1292              
1293             if($PrintCflagsOnlyI) {
1294             @print_flags = grep /^-I/, $o->get_cflags;
1295             }
1296              
1297             if($PrintCflagsOnlyOther) {
1298             @print_flags = grep /^-[^I]/, $o->get_cflags;
1299             }
1300              
1301             if($PrintLibs) {
1302             @print_flags = $o->get_ldflags;
1303             }
1304              
1305             if ($PrintLibsOnlyOther) {
1306             @print_flags = grep /^-[^LRl]/, $o->get_ldflags;
1307             }
1308              
1309             # handle --libs-only-L and --libs-only-l but watch the case when
1310             # we got 'ppkg-config --libs-only-L --libs-only-l foo' which must behave just like
1311             # 'ppkg-config --libs-only-l foo'
1312              
1313             if($PrintLibsOnlyl or ($PrintLibsOnlyl and $PrintLibsOnlyL)) {
1314             @print_flags = grep /^-l/, $o->get_ldflags;
1315             } elsif ($PrintLibsOnlyL) {
1316             @print_flags = grep /^-[LR]/, $o->get_ldflags;
1317             }
1318              
1319             print scalar PkgConfig::_return_context(@print_flags);
1320             print "\n";
1321             exit(0);
1322              
1323             __END__