File: DataFeed.pm

package info (click to toggle)
libmodule-scandeps-perl 0.98-1
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 576 kB
  • ctags: 231
  • sloc: perl: 3,910; makefile: 10; ansic: 1
file content (143 lines) | stat: -rw-r--r-- 3,603 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
package Module::ScanDeps::DataFeed;
# No compile time deps!
#use strict; 
$Module::ScanDeps::DataFeed::VERSION = '0.09';

=head1 NAME

Module::ScanDeps::DataFeed - Runtime dependency scanning helper

=head1 SYNOPSIS

(internal use only)

=head1 DESCRIPTION

No user-serviceable parts inside.

This module is used by the L<Module::ScanDeps> run- and compile-time scanners.
It is included in the code run by C<Module::ScanDeps> and will write
a string of loaded modules and C<@INC> entries to a file. This is
achieved using an C<END {}> hook.

Implementation might change, so don't use it outside of Module::ScanDeps!

=cut

my $_filename;

sub import {
    my ($pkg, $filename) = @_;
    # This is the file we'll write the @INC and %INC info to at END.
    $_filename = $filename;

    my $fname = __PACKAGE__;
    $fname =~ s{::}{/}g;
    delete $INC{"$fname.pm"} unless $Module::ScanDeps::DataFeed::Loaded;
    $Module::ScanDeps::DataFeed::Loaded++;
}

END {
    # Write %INC and @INC to the file specified at compile time in import()
    defined $_filename or return;

    my %inc = %INC;
    my @inc = @INC;
    my @dl_so = _dl_shared_objects();

    require Cwd;
    require File::Basename;
    require DynaLoader;

    open(FH, "> $_filename") or die "Couldn't open $_filename\n";
    print FH '%inchash = (' . "\n\t";
    print FH join(
        ',' => map {
            sprintf(
                "\n\t'$_' => '%s/%s'",
                Cwd::abs_path(File::Basename::dirname($inc{$_})),
                File::Basename::basename($inc{$_}),
            ),
        } keys(%inc)
    );
    print FH "\n);\n";

    print FH '@incarray = (' . "\n\t";
    # inner map escapes trailing backslashes
    print FH join(',', map("\n\t'$_'", map {s/\\$/\\\\/; $_} @inc));
    print FH "\n);\n";

    my @dl_bs = @dl_so;
    s/(\.so|\.dll)$/\.bs/ for @dl_bs;

    print FH '@dl_shared_objects = (' . "\n\t";
    print FH join(
        ',' => map("\n\t'$_'", grep -e, @dl_so, @dl_bs)
    );
    print FH "\n);\n";
    close FH;
}

sub _dl_shared_objects {
    if (@DynaLoader::dl_shared_objects) {
        return @DynaLoader::dl_shared_objects;
    }
    elsif (@DynaLoader::dl_modules) {
        return map { _dl_mod2filename($_) } @DynaLoader::dl_modules;
    }

    return;
}

sub _dl_mod2filename {
    my $mod = shift;

    return if $mod eq 'B';
    return unless defined &{"$mod\::bootstrap"};

    eval { require B; require Config; 1 } or return;
    my $dl_ext = $Config::Config{dlext};

    # Copied from XSLoader
    my @modparts = split(/::/, $mod);
    my $modfname = $modparts[-1];
    my $modpname = join('/', @modparts);

    foreach my $dir (@INC) {
        my $file = "$dir/auto/$modpname/$modfname.$dl_ext";
        return $file if -r $file;
    }

    return;
}

1;

=head1 SEE ALSO

L<Module::ScanDeps>

=head1 AUTHORS

Edward S. Peschko E<lt>esp5@pge.comE<gt>,
Audrey Tang E<lt>cpan@audreyt.orgE<gt>,
to a lesser degree Steffen Mueller E<lt>smueller@cpan.orgE<gt>

L<http://par.perl.org/> is the official website for this module.  You
can write to the mailing list at E<lt>par@perl.orgE<gt>, or send an empty
mail to E<lt>par-subscribe@perl.orgE<gt> to participate in the discussion.

Please submit bug reports to E<lt>bug-Module-ScanDeps@rt.cpan.orgE<gt>.

=head1 COPYRIGHT

Copyright 2004-2009 by Edward S. Peschko E<lt>esp5@pge.comE<gt>,
Audrey Tang E<lt>cpan@audreyt.orgE<gt>,
Steffen Mueller E<lt>smueller@cpan.orgE<gt>

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

See L<http://www.perl.com/perl/misc/Artistic.html>

=cut