home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / DataFeed.pm < prev    next >
Encoding:
Perl POD Document  |  2004-01-25  |  3.1 KB  |  133 lines
  1. # $File: //member/autrijus/Module-ScanDeps/lib/Module/ScanDeps/DataFeed.pm $ $Author: autrijus $
  2. # $Revision: #4 $ $Change: 9766 $ $DateTime: 2004/01/25 16:11:51 $ vim: expandtab shiftwidth=4
  3.  
  4. package Module::ScanDeps::DataFeed;
  5. $Module::ScanDeps::DataFeed::VERSION = '0.02';
  6.  
  7. =head1 NAME
  8.  
  9. Module::ScanDeps::DataFeed - Runtime dependency scanning helper
  10.  
  11. =head1 SYNOPSIS
  12.  
  13. (internal use only)
  14.  
  15. =head1 DESCRIPTION
  16.  
  17. No user-serviceable parts inside.
  18.  
  19. =cut
  20.  
  21. my $_filename;
  22.  
  23. sub import {
  24.     my ($pkg, $filename) = @_;
  25.     $_filename = $filename;
  26.  
  27.     my $fname = __PACKAGE__;
  28.     $fname =~ s{::}{/}g;
  29.     delete $INC{"$fname.pm"} unless $Module::ScanDeps::DataFeed::Loaded;
  30.     $Module::ScanDeps::DataFeed::Loaded++;
  31. }
  32.  
  33. END {
  34.     defined $_filename or return;
  35.  
  36.     my %inc = %INC;
  37.     my @inc = @INC;
  38.     my @dl_so = _dl_shared_objects();
  39.  
  40.     require Cwd;
  41.     require File::Basename;
  42.     require DynaLoader;
  43.  
  44.     open(FH, "> $_filename") or die "Couldn't open $_filename\n";
  45.     print FH '%inchash = (' . "\n\t";
  46.     print FH join(
  47.         ',' => map {
  48.             sprintf(
  49.                 "\n\t'$_' => '%s/%s'",
  50.                 Cwd::abs_path(File::Basename::dirname($inc{$_})),
  51.                 File::Basename::basename($inc{$_}),
  52.             ),
  53.         } keys(%inc)
  54.     );
  55.     print FH "\n);\n";
  56.  
  57.     print FH '@incarray = (' . "\n\t";
  58.     print FH join(',', map("\n\t'$_'", @inc));
  59.     print FH "\n);\n";
  60.  
  61.     my @dl_bs = @dl_so;
  62.     s/(\.so|\.dll)$/\.bs/ for @dl_bs;
  63.  
  64.     print FH '@dl_shared_objects = (' . "\n\t";
  65.     print FH join(
  66.         ',' => map("\n\t'$_'", grep -e, @dl_so, @dl_bs)
  67.     );
  68.     print FH "\n);\n";
  69.     close FH;
  70. }
  71.  
  72. sub _dl_shared_objects {
  73.     if (@DynaLoader::dl_shared_objects) {
  74.         return @DynaLoader::dl_shared_objects;
  75.     }
  76.     elsif (@DynaLoader::dl_modules) {
  77.         return map { _dl_mod2filename($_) } @DynaLoader::dl_modules;
  78.     }
  79.  
  80.     return;
  81. }
  82.  
  83. sub _dl_mod2filename {
  84.     my $mod = shift;
  85.  
  86.     return if $mod eq 'B';
  87.     return unless defined &{"$mod\::bootstrap"};
  88.  
  89.     eval { require B; require Config; 1 } or return;
  90.     my $dl_ext = $Config::Config{dlext} if %Config::Config;
  91.  
  92.     # Copied from XSLoader
  93.     my @modparts = split(/::/, $mod);
  94.     my $modfname = $modparts[-1];
  95.     my $modpname = join('/', @modparts);
  96.  
  97.     foreach my $dir (@INC) {
  98.         $file = "$dir/auto/$modpname/$modfname.$dl_ext";
  99.         return $file if -r $file;
  100.     }
  101.  
  102.     return;
  103. }
  104.  
  105. 1;
  106.  
  107. =head1 SEE ALSO
  108.  
  109. L<Module::ScanDeps>
  110.  
  111. =head1 AUTHORS
  112.  
  113. Edward S. Peschko E<lt>esp5@pge.comE<gt>,
  114. Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>
  115.  
  116. L<http://par.perl.org/> is the official website for this module.  You
  117. can write to the mailing list at E<lt>par@perl.orgE<gt>, or send an empty
  118. mail to E<lt>par-subscribe@perl.orgE<gt> to participate in the discussion.
  119.  
  120. Please submit bug reports to E<lt>bug-Module-ScanDeps@rt.cpan.orgE<gt>.
  121.  
  122. =head1 COPYRIGHT
  123.  
  124. Copyright 2004 by Edward S. Peschko E<lt>esp5@pge.comE<gt>,
  125. Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>
  126.  
  127. This program is free software; you can redistribute it and/or modify it
  128. under the same terms as Perl itself.
  129.  
  130. See L<http://www.perl.com/perl/misc/Artistic.html>
  131.  
  132. =cut
  133.