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.26 by root, Mon Sep 23 13:03:48 2013 UTC vs.
Revision 1.27 by root, Tue Sep 24 09:32:16 2013 UTC

… …
336 for @{ $self->{packlist}{$_} }; 336 for @{ $self->{packlist}{$_} };
337 337
338# for (grep /\.pm$/, @{ $self->{packlist}{$_} }) { 338# for (grep /\.pm$/, @{ $self->{packlist}{$_} }) {
339# s/\.pm$//; 339# s/\.pm$//;
340# s%/%::%g; 340# s%/%::%g;
341# my $pkg = "libextractor" . ++$self->{count}; 341# my $pkg = "Perl::LibExtractor::trace::_add_" . ++$self->{count};
342# $self->add_eval ("{ package $pkg; eval 'use $_' }") 342# $self->add_eval ("{ package $pkg; eval 'use $_' }")
343# unless $self->{_add_do}{$_}++; 343# unless $self->{_add_do}{$_}++;
344# } 344# }
345# 345#
346# $self->{_add_do}{$_}++ or $self->add_eval ("do q\x00$_\x00") 346# $self->{_add_do}{$_}++ or $self->add_eval ("do q\x00$_\x00")
… …
423 my $dir = $tmpdir->dirname; 423 my $dir = $tmpdir->dirname;
424 424
425 open my $fh, ">:perlio", "$dir/eval" 425 open my $fh, ">:perlio", "$dir/eval"
426 or croak "$dir/eval: $!"; 426 or croak "$dir/eval: $!";
427 syswrite $fh, 427 syswrite $fh,
428 'BEGIN { '
428 'BEGIN { @INC = (' . (join ", ", map "q\x00$_\x00", @{ $self->{inc} }) . ") }\n" 429 . '@INC = (' . (join ", ", map "q\x00$_\x00", @{ $self->{inc} }) . ');'
429 . "BEGIN { chdir q\x00$dir\x00 or die q\x00$dir: \$!\x00 }\n" 430 . "chdir q\x00$dir\x00 or die q\x00$dir\x00 . \": \$!\";"
431 . '$Perl::LibExtractor::EXTRACTING = 1;'
432 . '}'
430 . 'BEGIN { ' . (delete $self->{trace_begin}) . "}\n" 433 . 'BEGIN { ' . (delete $self->{trace_begin}) . "}\n"
431 . "CHECK {\n" 434 . "CHECK {\n"
432 . 'open STDOUT, ">:raw", "out" or die "out: $!";' 435 . 'open STDOUT, ">:raw", "out" or die "out: $!";'
433 . 'print join "\x00", values %INC;' 436 . 'print join "\x00", values %INC;'
434 . 'open STDERR, ">stderr";' # suppress "syntax OK" message from perl 437 . 'open STDERR, ">stderr";' # suppress "syntax OK" message from perl
435 . "}\n" 438 . "}\n"
436 . (delete $self->{trace_check}); 439 . (delete $self->{trace_check});
437 close $fh; 440 close $fh;
438 441
442 system "cat $dir/eval >/tmp/x";#d#
443
439 system _perl_path, "-c", "$dir/eval" 444 system _perl_path, "-c", "$dir/eval"
440 and croak "trace failure, check trace process output - caught"; 445 and croak "trace failure, check trace process output - caught";
441 446
442 my @inc = split /\x00/, do { 447 my @inc = split /\x00/, do {
443 open my $fh, "<:perlio", "$dir/out" 448 open my $fh, "<:perlio", "$dir/out"
… …
481 486
482sub add_mod { 487sub add_mod {
483 my $self = shift; 488 my $self = shift;
484 489
485 for (@_) { 490 for (@_) {
486 my $pkg = "libextractor" . ++$self->{count}; 491 my $pkg = "Perl::LibExtractor::trace::mod_" . ++$self->{count};
487 $self->_trace ("use $_", "{ package $pkg; use $_ }") 492 $self->_trace ("use $_", "{ package $pkg; use $_ }")
488 unless $self->{add_mod}{$_}++; 493 unless $self->{add_mod}{$_}++;
489 } 494 }
490} 495}
491 496
… …
566sub add_eval { 571sub add_eval {
567 my ($self, $eval) = @_; 572 my ($self, $eval) = @_;
568 573
569 (my $file = substr $eval, 0, 64) =~ s/\015?\012/\\n/g; 574 (my $file = substr $eval, 0, 64) =~ s/\015?\012/\\n/g;
570 575
571 my $pkg = "libextractor" . ++$self->{count}; 576 my $pkg = "Perl::LibExtractor::trace::eval_" . ++$self->{count};
572 $eval =~ s/\x00/\x00."\\x00".q\x00/g; 577 $eval =~ s/\x00/\x00."\\x00".q\x00/g;
573 $self->_trace ($file, 578 $self->_trace ($file,
574 "local \$^H = \$^H;" # vvvvvvvvvvvvvvvvvvvv = use strict; use utf8 579 "local \$^H = \$^H;" # vvvvvvvvvvvvvvvvvvvv = use strict; use utf8
575 . "eval q\x00package $pkg; BEGIN { \$^H = \$^H | 0x800600 } $eval\x00; die \"\$\@\" if \$\@;\n" 580 . "eval q\x00package $pkg; BEGIN { \$^H = \$^H | 0x800600 } $eval\x00; die \"\$\@\" if \$\@;\n"
576 ); 581 );
… …
939sub set { 944sub set {
940 $_[0]->_trace_flush; 945 $_[0]->_trace_flush;
941 $_[0]{set} 946 $_[0]{set}
942} 947}
943 948
949=head1 EXTRACTION PROCESS
950
951This module uses two perl execution modes to trace dependencies:
952compiling only (as with the C<-c> switch) and running (the normal mode of
953execution).
954
955currently, scripts/binaries are compiled only, while everything else is
956executed.
957
958The variable C<$Perl::LibExtractor::EXTRACTING> exists and has a true
959value when code is executed for tracing, and can be used to avoid
960executing code that shouldn't be executed when determining dependencies,
961e.g. with C<defined>:
962
963 unless (defined $Perl::LibExtractor::EXTRACTING) {
964 open my $fh, "<some/resource/file"
965 or die "$!";
966 }
967
968You can test the truth value of C<$Perl::LibExtractor::EXTRACTING>
969directly, but using C<defined> doesn't issue a warning when uninitialized
970warnings are enabled.
971
944=head1 EXAMPLE 972=head1 EXAMPLE
945 973
946To package he deliantra client (L<Deliantra::Client>), finding all 974To package he deliantra client (L<Deliantra::Client>), finding all
947(perl) files needed to run it is a first step. This can be done by using 975(perl) files needed to run it is a first step. This can be done by using
948something like the following code snippet: 976something like the following code snippet:

Diff Legend

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