File: DataFeed.pm

package info (click to toggle)
libmodule-scandeps-perl 0.62-1
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 180 kB
  • ctags: 114
  • sloc: perl: 1,811; makefile: 43
file content (129 lines) | stat: -rw-r--r-- 2,947 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
package Module::ScanDeps::DataFeed;
$Module::ScanDeps::DataFeed::VERSION = '0.03';

=head1 NAME

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

=head1 SYNOPSIS

(internal use only)

=head1 DESCRIPTION

No user-serviceable parts inside.

=cut

my $_filename;

sub import {
    my ($pkg, $filename) = @_;
    $_filename = $filename;

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

END {
    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";
    print FH join(',', map("\n\t'$_'", @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} if %Config::Config;

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

    foreach my $dir (@INC) {
        $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>autrijus@autrijus.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, 2005 by Edward S. Peschko E<lt>esp5@pge.comE<gt>,
Audrey Tang E<lt>autrijus@autrijus.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