File Coverage

blib/lib/PkgConfig.pm
Criterion Covered Total %
statement 286 390 73.3
branch 50 102 49.0
condition 14 26 53.8
subroutine 49 56 87.5
pod 4 18 22.2
total 403 592 68.0


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