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.10 by root, Tue Jan 17 17:44:09 2012 UTC vs.
Revision 1.11 by root, Tue Jan 17 21:41:41 2012 UTC

… …
156 $re =~ s%\\[/\\]%[/\\\\]%g; # we support / and \ on all OSes, keep your fingers crossed 156 $re =~ s%\\[/\\]%[/\\\\]%g; # we support / and \ on all OSes, keep your fingers crossed
157 157
158 $case_tolerant 158 $case_tolerant
159 ? qr<$re>i 159 ? qr<$re>i
160 : qr<$re> 160 : qr<$re>
161}
162
163sub _read_packlist {
164 my ($self, $root, $path) = @_;
165
166 my $lib = $self->{lib};
167
168 my @packlist;
169
170 open my $fh, "<:perlio", "$root/$path"
171 or die "$root/$path: $!";
172
173 $root = _path2match $root;
174
175 while (<$fh>) {
176 chomp;
177 s/ .*$//; # newer-style .packlists might contain key=value pairs
178
179 s/$root// and exists $lib->{$_}
180 or next;
181
182 push @packlist, canonpath $_;
183 }
184
185 \@packlist
161} 186}
162 187
163sub _set_inc { 188sub _set_inc {
164 my ($self) = @_; 189 my ($self) = @_;
165 190
… …
201 226
202 my %packlist; 227 my %packlist;
203 228
204 # need to go forward here 229 # need to go forward here
205 for (@packlists) { 230 for (@packlists) {
206 my ($root, $auto) = @$_; 231 my $packlist = $self->_read_packlist ($_->[0], "$_->[1]/.packlist");
207 232
208 my @packlist;
209
210 open my $fh, "<:perlio", "$root/$auto/.packlist"
211 or die "$root/$auto/.packlist: $!";
212
213 $root = _path2match $root;
214
215 while (<$fh>) {
216 chomp;
217 s/ .*$//; # newer-style .packlists might contain key=value pairs
218
219 s/$root// or next;
220 $_ = canonpath $_;
221 exists $lib{$_} or next;
222
223 push @packlist, $_;
224 $packlist{$_} = \@packlist; 233 $packlist{$_} = $packlist
225 } 234 for @$packlist;
226 } 235 }
227 236
228 $self->{lib} = \%lib; 237 $self->{lib} = \%lib;
229 $self->{packlist} = \%packlist; 238 $self->{packlist} = \%packlist;
230 $self->{matchprefix} = $matchprefix; 239 $self->{matchprefix} = $matchprefix;
… …
592 $self->add_eval ('/\x{1234}(?<a>)\g{a}/') if $] >= 5.010; # usually covered by the regex above 601 $self->add_eval ('/\x{1234}(?<a>)\g{a}/') if $] >= 5.010; # usually covered by the regex above
593} 602}
594 603
595=item $extractor->add_unicore 604=item $extractor->add_unicore
596 605
597Adds (hopefully) all files form the unicore database that will ever be 606Adds (hopefully) all files from the unicore database that will ever be
598needed. 607needed.
599 608
600If you are not sure which unicode character classes and similar unicore 609If you are not sure which unicode character classes and similar unicore
601databases you need, and you do not care about an extra one thousand(!) 610databases you need, and you do not care about an extra one thousand(!)
602files comprising 4MB of data, then you can just call this method, which 611files comprising 4MB of data, then you can just call this method, which
603adds basically all files from perl's unicode database. 612adds basically all files from perl's unicode database.
604 613
614Note that C<add_core_support> also adds some unicore files, but it's not a
615subset of C<add_unicore> - the former adds all files neccessary to support
616core builtins (which includes some unicore files and other things), while
617the latter adds all unicore files (but nothing else).
618
619When in doubt, use both.
620
605=cut 621=cut
606 622
607sub add_unicore { 623sub add_unicore {
608 my ($self) = @_; 624 my ($self) = @_;
609 625
610 $self->_add ([grep m%^unicore/.*\.pl$%, keys %{ $self->{lib} }]); 626 $self->_add ([grep m%^unicore/.*\.pl$%, keys %{ $self->{lib} }]);
627}
628
629=item $extractor->add_core
630
631This adds all files from the perl core distribution, that is, all library
632files that come with perl.
633
634This is a superset of C<add_core_support> and C<add_unicore>.
635
636This is quite a lot, but on the plus side, you can be sure nothing is
637missing.
638
639This requires a full perl installation - many distributions (Debian
640GNU/Linux for example) don't package all library files that perl installs.
641
642=cut
643
644sub add_core {
645 my ($self) = @_;
646
647 my $lib = $self->{lib};
648
649 for (@{
650 $self->_read_packlist ($Config{privlibexp}, ".packlist")
651 }) {
652 $self->{set}{$_} ||= [
653 "$self->{libdir}/"
654 . ($lib->{$_} or croak "$_: unable to locate file in perl library")
655 ];
656 }
611} 657}
612 658
613=back 659=back
614 660
615=head2 GLOB-BASED ADDING AND FILTERING 661=head2 GLOB-BASED ADDING AND FILTERING
… …
773 # delete all extralibs.ld and extralibs.all (no clue what the latter is for) 819 # delete all extralibs.ld and extralibs.all (no clue what the latter is for)
774 delete @$set{ grep m%^\Q$self->{libdir}\E/auto/.*/extralibs\.(?:ld|all)$%s, keys %$set }; 820 delete @$set{ grep m%^\Q$self->{libdir}\E/auto/.*/extralibs\.(?:ld|all)$%s, keys %$set };
775 821
776 # delete all .pod, .h, .html files (hopefully none of them are used at runtime) 822 # delete all .pod, .h, .html files (hopefully none of them are used at runtime)
777 delete @$set{ grep m%^\Q$self->{libdir}\E/.*\.(?:pod|h|html)$%s, keys %$set }; 823 delete @$set{ grep m%^\Q$self->{libdir}\E/.*\.(?:pod|h|html)$%s, keys %$set };
824
825 # delete unneeded unicore files
826 delete @$set{ grep m%^\Q$self->{libdir}\E/unicore/(?:mktables(?:\.lst)?|.*\.txt)$%s, keys %$set };
778} 827}
779 828
780=back 829=back
781 830
782=head2 RESULT SET 831=head2 RESULT SET

Diff Legend

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