ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cvsroot/Perl-LibExtractor/LibExtractor.pm
(Generate patch)

Comparing cvsroot/Perl-LibExtractor/LibExtractor.pm (file contents):
Revision 1.7 by root, Mon Jan 16 18:46:05 2012 UTC vs.
Revision 1.8 by root, Mon Jan 16 22:24:47 2012 UTC

… …
47sub croak($) { 47sub croak($) {
48 require Carp; 48 require Carp;
49 Carp::croak "(Perl::LibExtractor) $_[0]"; 49 Carp::croak "(Perl::LibExtractor) $_[0]";
50} 50}
51 51
52my $canonpath = File::Spec->can ("canonpath"); 52my $canonpath = File::Spec->can ("canonpath");
53my $case_tolerant = File::Spec->case_tolerant;
53 54
54sub canonpath($) { 55sub canonpath($) {
55 local $_ = $canonpath->(File::Spec::, $_[0]); 56 local $_ = $canonpath->(File::Spec::, $_[0]);
56 s%\\%/%g; 57 s%\\%/%g;
58# $_ = lc if $case_tolerant; # we assume perl file name case is always the same
57 $_ 59 $_
58} 60}
59 61
60=head2 CREATION 62=head2 CREATION
61 63
… …
145 } 147 }
146 148
147 $secure_perl_path 149 $secure_perl_path
148} 150}
149 151
152sub _path2match {
153 my $re = join "|", map "\Q$_", @_;
154
155 $re = "(?:$re)\\/";
156 $re =~ s%\\[/\\]%[/\\\\]%g; # we support / and \ on all OSes, keep your fingers crossed
157
158 $case_tolerant
159 ? qr<$re>i
160 : qr<$re>
161}
162
150sub _set_inc { 163sub _set_inc {
151 my ($self) = @_; 164 my ($self) = @_;
152 165
153 $self->{inc} = [ map canonpath $_, @{ $self->{inc }} ];
154
155 my $matchprefix = join "|", map "\Q$_", @{ $self->{inc }}; 166 my $matchprefix = _path2match @{ $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
160 $matchprefix = qr<^(?:$matchprefix)/>;
161 167
162 my %lib; 168 my %lib;
163 my @packlists; 169 my @packlists;
164 170
165 # find all files in all libdirs, earlier ones overwrite later ones 171 # find all files in all libdirs, earlier ones overwrite later ones
… …
202 my @packlist; 208 my @packlist;
203 209
204 open my $fh, "<:perlio", "$root/$auto/.packlist" 210 open my $fh, "<:perlio", "$root/$auto/.packlist"
205 or die "$root/$auto/.packlist: $!"; 211 or die "$root/$auto/.packlist: $!";
206 212
207 $root = qr<^\Q$root/>; 213 $root = _path2match $root;
208 214
209 while (<$fh>) { 215 while (<$fh>) {
210 chomp; 216 chomp;
211 s/ .*$//; # newer-style .packlists might contain key=value pairs 217 s/ .*$//; # newer-style .packlists might contain key=value pairs
212 218
213 s/$root// or next; 219 s/$root// or next;
220 $_ = canonpath $_;
214 exists $lib{$_} or next; 221 exists $lib{$_} or next;
215 222
216 push @packlist, $_; 223 push @packlist, $_;
217 $packlist{$_} = \@packlist; 224 $packlist{$_} = \@packlist;
218 } 225 }
219 } 226 }
220 227
221 $self->{lib} = \%lib; 228 $self->{lib} = \%lib;
222 $self->{packlist} = \%packlist; 229 $self->{packlist} = \%packlist;
223 $self->{matchprefix} = $matchprefix; 230 $self->{matchprefix} = $matchprefix;
224} 231}
225 232
226=back 233=back
227 234
… …
398 or croak "$dir/out: $!"; 405 or croak "$dir/out: $!";
399 local $/; 406 local $/;
400 scalar readline $fh 407 scalar readline $fh
401 }; 408 };
402 409
403 $_ = canonpath $_
404 for @inc;
405
406 my $matchprefix = $self->{matchprefix}; 410 my $matchprefix = $self->{matchprefix};
407 411
408 # remove the library directory prefix, hope for the best 412 # remove the library directory prefix, hope for the best
409 s/$matchprefix// 413 s/$matchprefix//
410 or croak "$_: file outside any library directory" 414 or croak "$_: file outside any library directory"
… …
538 # that means we can't find the libperl.so, because dbeian actively breaks 542 # that means we can't find the libperl.so, because dbeian actively breaks
539 # their perl install, and we don't need it. we work around this by silently 543 # their perl install, and we don't need it. we work around this by silently
540 # not including the libperl if we cannot find it. 544 # not including the libperl if we cannot find it.
541 545
542 if ($Config{useshrplib} eq "true") { 546 if ($Config{useshrplib} eq "true") {
547 my ($libperl, $libpath);
548
549 if ($^O eq "cygwin") {
550 $libperl = $Config{libperl};
551 $libpath = "$Config{binexp}/$libperl";
552 } elsif ($^O eq "MSWin32") {
553 ($libperl = $Config{libperl}) =~ s/\Q$Config{_a}\E$/.$Config{so}/;
554 $libpath = "$Config{binexp}/$libperl";
555 } else {
556 $libperl = $Config{libperl};
543 if (my $libperl = $self->{lib}{"CORE/$Config{libperl}"}) { 557 $libpath = $self->{lib}{"CORE/$libperl"};
544 $self->{set}{"$self->{dlldir}/$Config{libperl}"} = $libperl;
545 } 558 }
559
560 $self->{set}{"$self->{dlldir}/$libperl"} = $libpath
561 if length $libpath && -e $libpath;
546 } 562 }
547} 563}
548 564
549=item $extractor->add_core_support 565=item $extractor->add_core_support
550 566
… …
735 751
736This removes all files that are not needed at runtime, such as static 752This removes all files that are not needed at runtime, such as static
737archives, header and other files needed only for compilation of modules, 753archives, header and other files needed only for compilation of modules,
738and pod and html files (which are unlikely to be needed at runtime). 754and pod and html files (which are unlikely to be needed at runtime).
739 755
740This is quite useful when you want to have only fiels actually needed to 756This is quite useful when you want to have only files actually needed to
741execute a program. 757execute a program.
742 758
743=cut 759=cut
744 760
745sub runtime_only { 761sub runtime_only {
… …
747 763
748 $self->_trace_flush; 764 $self->_trace_flush;
749 765
750 my $set = $self->{set}; 766 my $set = $self->{set};
751 767
752 # delete all static libraries 768 # delete all static libraries, also windows stuff
753 delete @$set{ grep m%^\Q$self->{libdir}\E/auto/(?:.+/)?([^\/]+)/\1\Q$Config{_a}\E$%s, keys %$set }; 769 delete @$set{ grep m%^\Q$self->{libdir}\E/auto/(?:.+/)?([^\/]+)/\1(?:\Q$Config{_a}\E|\.pdb|\.exp)$%s, keys %$set };
754 770
755 # delete all extralibs.ld and extralibs.all (no clue what the latter is for) 771 # delete all extralibs.ld and extralibs.all (no clue what the latter is for)
756 delete @$set{ grep m%^\Q$self->{libdir}\E/auto/.*/extralibs\.(?:ld|all)$%s, keys %$set }; 772 delete @$set{ grep m%^\Q$self->{libdir}\E/auto/.*/extralibs\.(?:ld|all)$%s, keys %$set };
757 773
758 # delete all .pod, .h, .html files (hopefully none of them are used at runtime) 774 # delete all .pod, .h, .html files (hopefully none of them are used at runtime)
759 delete @$set{ grep m%^\Q$self->{libdir}\E/.*.(?:pod|h|html)$%s, keys %$set }; 775 delete @$set{ grep m%^\Q$self->{libdir}\E/.*\.(?:pod|h|html)$%s, keys %$set };
760} 776}
761 777
762=back 778=back
763 779
764=head2 RESULT SET 780=head2 RESULT SET

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines