local-lib5/lib/perl5/Module/ScanDeps/DataFeed.pm

   1 package Module::ScanDeps::DataFeed;
   2 # No compile time deps!
   3 #use strict;
   4 $Module::ScanDeps::DataFeed::VERSION = '0.09';
   5
   6 =head1 NAME
   7
   8 Module::ScanDeps::DataFeed - Runtime dependency scanning helper
   9
  10 =head1 SYNOPSIS
  11
  12 (internal use only)
  13
  14 =head1 DESCRIPTION
  15
  16 No user-serviceable parts inside.
  17
  18 This module is used by the L<Module::ScanDeps> run- and compile-time scanners.
  19 It is included in the code run by C<Module::ScanDeps> and will write
  20 a string of loaded modules and C<@INC> entries to a file. This is
  21 achieved using an C<END {}> hook.
  22
  23 Implementation might change, so don't use it outside of Module::ScanDeps!
  24
  25 =cut
  26
  27 my $_filename;
  28
  29 sub import {
  30     my ($pkg, $filename) = @_;
  31     # This is the file we'll write the @INC and %INC info to at END.
  32     $_filename = $filename;
  33
  34     my $fname = __PACKAGE__;
  35     $fname =~ s{::}{/}g;
  36     delete $INC{"$fname.pm"} unless $Module::ScanDeps::DataFeed::Loaded;
  37     $Module::ScanDeps::DataFeed::Loaded++;
  38 }
  39
  40 END {
  41     # Write %INC and @INC to the file specified at compile time in import()
  42     defined $_filename or return;
  43
  44     my %inc = %INC;
  45     my @inc = @INC;
  46     my @dl_so = _dl_shared_objects();
  47
  48     require Cwd;
  49     require File::Basename;
  50     require DynaLoader;
  51
  52     open(FH, "> $_filename") or die "Couldn't open $_filename\n";
  53     print FH '%inchash = (' . "\n\t";
  54     print FH join(
  55         ',' => map {
  56             sprintf(
  57                 "\n\t'$_' => '%s/%s'",
  58                 Cwd::abs_path(File::Basename::dirname($inc{$_})),
  59                 File::Basename::basename($inc{$_}),
  60             ),
  61         } keys(%inc)
  62     );
  63     print FH "\n);\n";
  64
  65     print FH '@incarray = (' . "\n\t";
  66     # inner map escapes trailing backslashes
  67     print FH join(',', map("\n\t'$_'", map {s/\\$/\\\\/; $_} @inc));
  68     print FH "\n);\n";
  69
  70     my @dl_bs = @dl_so;
  71     s/(\.so|\.dll)$/\.bs/ for @dl_bs;
  72
  73     print FH '@dl_shared_objects = (' . "\n\t";
  74     print FH join(
  75         ',' => map("\n\t'$_'", grep -e, @dl_so, @dl_bs)
  76     );
  77     print FH "\n);\n";
  78     close FH;
  79 }
  80
  81 sub _dl_shared_objects {
  82     if (@DynaLoader::dl_shared_objects) {
  83         return @DynaLoader::dl_shared_objects;
  84     }
  85     elsif (@DynaLoader::dl_modules) {
  86         return map { _dl_mod2filename($_) } @DynaLoader::dl_modules;
  87     }
  88
  89     return;
  90 }
  91
  92 sub _dl_mod2filename {
  93     my $mod = shift;
  94
  95     return if $mod eq 'B';
  96     return unless defined &{"$mod\::bootstrap"};
  97
  98     eval { require B; require Config; 1 } or return;
  99     my $dl_ext = $Config::Config{dlext} if %Config::Config;
 100
 101     # Copied from XSLoader
 102     my @modparts = split(/::/, $mod);
 103     my $modfname = $modparts[-1];
 104     my $modpname = join('/', @modparts);
 105
 106     foreach my $dir (@INC) {
 107         my $file = "$dir/auto/$modpname/$modfname.$dl_ext";
 108         return $file if -r $file;
 109     }
 110
 111     return;
 112 }
 113
 114 1;
 115
 116 =head1 SEE ALSO
 117
 118 L<Module::ScanDeps>
 119
 120 =head1 AUTHORS
 121
 122 Edward S. Peschko E<lt>esp5@pge.comE<gt>,
 123 Audrey Tang E<lt>cpan@audreyt.orgE<gt>,
 124 to a lesser degree Steffen Mueller E<lt>smueller@cpan.orgE<gt>
 125
 126 L<http://par.perl.org/> is the official website for this module.  You
 127 can write to the mailing list at E<lt>par@perl.orgE<gt>, or send an empty
 128 mail to E<lt>par-subscribe@perl.orgE<gt> to participate in the discussion.
 129
 130 Please submit bug reports to E<lt>bug-Module-ScanDeps@rt.cpan.orgE<gt>.
 131
 132 =head1 COPYRIGHT
 133
 134 Copyright 2004-2009 by Edward S. Peschko E<lt>esp5@pge.comE<gt>,
 135 Audrey Tang E<lt>cpan@audreyt.orgE<gt>,
 136 Steffen Mueller E<lt>smueller@cpan.orgE<gt>
 137
 138 This program is free software; you can redistribute it and/or modify it
 139 under the same terms as Perl itself.
 140
 141 See L<http://www.perl.com/perl/misc/Artistic.html>
 142
 143 =cut