| … | |
… | |
| 34 | package Perl::LibExtractor; |
34 | package Perl::LibExtractor; |
| 35 | |
35 | |
| 36 | our $VERSION = '0.1'; |
36 | our $VERSION = '0.1'; |
| 37 | |
37 | |
| 38 | use Config; |
38 | use Config; |
|
|
39 | use File::Spec (); |
| 39 | use File::Temp (); |
40 | use File::Temp (); |
| 40 | |
41 | |
| 41 | use common::sense; |
42 | use common::sense; |
| 42 | |
43 | |
| 43 | sub I_SRC () { 0 } |
44 | sub I_SRC () { 0 } |
| 44 | sub I_DEP () { 1 } |
45 | sub I_DEP () { 1 } |
| 45 | |
46 | |
| 46 | sub croak($) { |
47 | sub croak($) { |
| 47 | require Carp; |
48 | require Carp; |
| 48 | Carp::croak "(Perl::LibExtractor) $_[0]"; |
49 | Carp::croak "(Perl::LibExtractor) $_[0]"; |
|
|
50 | } |
|
|
51 | |
|
|
52 | my $canonpath = File::Spec->can ("canonpath"); |
|
|
53 | |
|
|
54 | sub canonpath($) { |
|
|
55 | local $_ = $canonpath->(File::Spec::, $_[0]); |
|
|
56 | s%\\%/%g; |
|
|
57 | $_ |
| 49 | } |
58 | } |
| 50 | |
59 | |
| 51 | =head2 CREATION |
60 | =head2 CREATION |
| 52 | |
61 | |
| 53 | =over 4 |
62 | =over 4 |
| … | |
… | |
| 139 | } |
148 | } |
| 140 | |
149 | |
| 141 | sub _set_inc { |
150 | sub _set_inc { |
| 142 | my ($self) = @_; |
151 | my ($self) = @_; |
| 143 | |
152 | |
|
|
153 | $self->{inc} = [ map canonpath $_, @{ $self->{inc }} ]; |
|
|
154 | |
| 144 | my $matchprefix = join "|", map "\Q$_", @{ $self->{inc }}; |
155 | my $matchprefix = join "|", map "\Q$_", @{ $self->{inc }}; |
|
|
156 | |
|
|
157 | $matchprefix =~ s%\\[/\\]%[/\\\\]%g; # we support / and \ on all OSes, keep your fingers crossed |
|
|
158 | $matchprefix = qr<$matchprefix>i if File::Spec->case_tolerant; |
|
|
159 | |
| 145 | $matchprefix = qr<^(?:$matchprefix)/>; |
160 | $matchprefix = qr<^(?:$matchprefix)/>; |
| 146 | |
161 | |
| 147 | my %lib; |
162 | my %lib; |
| 148 | my @packlists; |
163 | my @packlists; |
| 149 | |
164 | |
| … | |
… | |
| 192 | $root = qr<^\Q$root/>; |
207 | $root = qr<^\Q$root/>; |
| 193 | |
208 | |
| 194 | while (<$fh>) { |
209 | while (<$fh>) { |
| 195 | chomp; |
210 | chomp; |
| 196 | s/ .*$//; # newer-style .packlists might contain key=value pairs |
211 | s/ .*$//; # newer-style .packlists might contain key=value pairs |
| 197 | s%/\./%/%g; # yeah, these too |
|
|
| 198 | |
212 | |
| 199 | s/$root// or next; |
213 | s/$root// or next; |
| 200 | exists $lib{$_} or next; |
214 | exists $lib{$_} or next; |
| 201 | |
215 | |
| 202 | push @packlist, $_; |
216 | push @packlist, $_; |
| … | |
… | |
| 384 | or croak "$dir/out: $!"; |
398 | or croak "$dir/out: $!"; |
| 385 | local $/; |
399 | local $/; |
| 386 | scalar readline $fh |
400 | scalar readline $fh |
| 387 | }; |
401 | }; |
| 388 | |
402 | |
|
|
403 | $_ = canonpath $_ |
|
|
404 | for @inc; |
|
|
405 | |
| 389 | my $matchprefix = $self->{matchprefix}; |
406 | my $matchprefix = $self->{matchprefix}; |
| 390 | |
407 | |
| 391 | # remove the library directory prefix, hope for the best |
408 | # remove the library directory prefix, hope for the best |
| 392 | s/$matchprefix// |
409 | s/$matchprefix// |
| 393 | or croak "$_: file outside any library directory" |
410 | or croak "$_: file outside any library directory" |
| … | |
… | |
| 454 | my $file = do { local $/; readline $fh }; |
471 | my $file = do { local $/; readline $fh }; |
| 455 | |
472 | |
| 456 | $self->_trace_flush if exists $self->{trace_check}; |
473 | $self->_trace_flush if exists $self->{trace_check}; |
| 457 | $self->{trace_check} = $file; |
474 | $self->{trace_check} = $file; |
| 458 | |
475 | |
| 459 | $self->{set}{"$self->{exedir}/$exe"} = ["$dir/$exe"]; |
476 | $self->{set}{"$self->{bindir}/$exe"} = ["$dir/$exe"]; |
| 460 | next exe; |
477 | next exe; |
| 461 | } |
478 | } |
| 462 | } |
479 | } |
| 463 | |
480 | |
| 464 | croak "add_script ($exe): executable not found"; |
481 | croak "add_script ($exe): executable not found"; |
| … | |
… | |
| 509 | =cut |
526 | =cut |
| 510 | |
527 | |
| 511 | sub add_perl { |
528 | sub add_perl { |
| 512 | my ($self) = @_; |
529 | my ($self) = @_; |
| 513 | |
530 | |
| 514 | $self->{set}{"$self->{bindir}/perl$Config{_exe}"} = [_perl_path]; |
531 | $self->{set}{"$self->{exedir}/perl$Config{_exe}"} = [_perl_path]; |
| 515 | |
532 | |
| 516 | # on debian, we have the special case of a perl binary linked against |
533 | # on debian, we have the special case of a perl binary linked against |
| 517 | # a static libperl.a (which is not available), but the Config says to use |
534 | # a static libperl.a (which is not available), but the Config says to use |
| 518 | # a shared library, which is in the wrong directory, too (which breaks |
535 | # a shared library, which is in the wrong directory, too (which breaks |
| 519 | # every other perl installation on the system - they are so stupid). |
536 | # every other perl installation on the system - they are so stupid). |
