Commit | Line | Data |
4a656c5e |
1 | #!perl |
2 | # Generates info for Module::CoreList from this perl tree |
3 | # run this from the root of a clean perl tree |
4 | |
4a656c5e |
5 | use strict; |
6 | use warnings; |
7 | use File::Find; |
8 | use ExtUtils::MM_Unix; |
fb237dfd |
9 | use lib "Porting"; |
10 | use Maintainers qw(%Modules files_to_modules); |
11 | use File::Spec; |
4a656c5e |
12 | |
59189dd7 |
13 | my %lines; |
fb237dfd |
14 | my %module_to_file; |
15 | my %modlist; |
16 | my $cpan = shift; |
17 | |
18 | if ($cpan) { |
19 | my $modlistfile |
20 | = File::Spec->catfile($cpan, 'modules', '02packages.details.txt'); |
21 | open my $fh, '<', $modlistfile or die "Couldn't open $modlistfile: $!"; |
22 | |
23 | { |
24 | local $/ = "\n\n"; |
25 | die "Incompatible modlist format" |
26 | unless <$fh> =~ /^Columns: +package name, version, path/m; |
27 | } |
28 | |
29 | # Converting the file to a hash is about 5 times faster than a regexp flat |
30 | # lookup. |
31 | while (<$fh>) { |
32 | next unless /^([A-Za-z_:0-9]+) +[-0-9.undefHASHVERSIONvsetwhenloadingbogus]+ +(\S+)/; |
33 | $modlist{$1} = $2; |
34 | } |
35 | } |
36 | |
4a656c5e |
37 | find(sub { |
38 | /(\.pm|_pm\.PL)$/ or return; |
d51d469b |
39 | /PPPort\.pm$/ and return; |
4a656c5e |
40 | my $module = $File::Find::name; |
d51d469b |
41 | $module =~ /\b(demo|t|private)\b/ and return; # demo or test modules |
42 | my $version = MM->parse_version($_); |
43 | defined $version or $version = 'undef'; |
4a656c5e |
44 | $version =~ /\d/ and $version = "'$version'"; |
45 | # some heuristics to figure out the module name from the file name |
4a626d91 |
46 | $module =~ s{^(lib|(win32/|vms/|symbian/)?ext)/}{} |
47 | and $1 ne 'lib' |
fb237dfd |
48 | and ( $module =~ s{\b(\w+)/\1\b}{$1}, |
dc5f10bb |
49 | $module =~ s{^B/O}{O}, |
da09dfe3 |
50 | $module =~ s{^Devel-PPPort}{Devel}, |
4a656c5e |
51 | $module =~ s{^Encode/encoding}{encoding}, |
da09dfe3 |
52 | $module =~ s{^IPC-SysV/}{IPC/}, |
53 | $module =~ s{^MIME-Base64/QuotedPrint}{MIME/QuotedPrint}, |
dc5f10bb |
54 | $module =~ s{^(?:DynaLoader|Errno|Opcode)/}{}, |
4a656c5e |
55 | ); |
56 | $module =~ s{/}{::}g; |
da09dfe3 |
57 | $module =~ s{-}{::}g; |
58 | $module =~ s{^.*::lib::}{}; |
4a656c5e |
59 | $module =~ s/(\.pm|_pm\.PL)$//; |
0fdd9e5c |
60 | $lines{$module} = $version; |
fb237dfd |
61 | $module_to_file{$module} = $File::Find::name; |
59189dd7 |
62 | }, 'lib', 'ext', 'vms/ext', 'symbian/ext'); |
63 | |
0fdd9e5c |
64 | -e 'configpm' and $lines{Config} = 'undef'; |
cc8432b2 |
65 | |
59189dd7 |
66 | if (open my $ucdv, "<", "lib/unicore/version") { |
67 | chomp (my $ucd = <$ucdv>); |
0fdd9e5c |
68 | $lines{Unicode} = "'$ucd'"; |
59189dd7 |
69 | close $ucdv; |
70 | } |
fb237dfd |
71 | |
72 | sub display_hash { |
73 | my ($hash) = @_; |
0fdd9e5c |
74 | } |
fb237dfd |
75 | |
76 | print " $] => {\n"; |
77 | printf "\t%-24s=> $lines{$_},\n", "'$_'" foreach sort keys %lines; |
4a656c5e |
78 | print " },\n"; |
fb237dfd |
79 | |
80 | exit unless %modlist; |
81 | |
82 | # We have to go through this two stage lookup, given how Maintainers.pl keys its |
83 | # data by "Module", which is really a dist. |
84 | my $file_to_M = files_to_modules(values %module_to_file); |
85 | |
86 | my %module_to_upstream; |
87 | my %module_to_dist; |
88 | my %dist_to_meta_YAML; |
89 | while (my ($module, $file) = each %module_to_file) { |
90 | my $M = $file_to_M->{$file}; |
91 | next unless $M; |
92 | next if $Modules{$M}{MAINTAINER} eq 'p5p'; |
93 | $module_to_upstream{$module} = $Modules{$M}{UPSTREAM}; |
94 | next if defined $module_to_upstream{$module} && |
95 | $module_to_upstream{$module} =~ /^(?:blead|first-come)$/; |
96 | my $dist = $modlist{$module}; |
97 | unless ($dist) { |
98 | warn "Can't find a distribution for $module"; |
99 | next; |
100 | } |
101 | $module_to_dist{$module} = $dist; |
102 | |
103 | next if exists $dist_to_meta_YAML{$dist}; |
104 | |
105 | $dist_to_meta_YAML{$dist} = undef; |
106 | |
107 | # Like it or lump it, this has to be Unix format. |
108 | my $meta_YAML_path = "$cpan/authors/id/$dist"; |
109 | $meta_YAML_path =~ s/(?:tar\.gz|zip)$/meta/ or die "$meta_YAML_path"; |
110 | unless (-e $meta_YAML_path) { |
111 | warn "$meta_YAML_path does not exist for $module"; |
112 | # I tried code to open the tarballs with Archive::Tar to find and |
113 | # extract META.yml, but only Text-Tabs+Wrap-2006.1117.tar.gz had one, |
114 | # so it's not worth including. |
115 | next; |
116 | } |
117 | require Parse::CPAN::Meta; |
118 | $dist_to_meta_YAML{$dist} = Parse::CPAN::Meta::LoadFile($meta_YAML_path); |
119 | } |
120 | |
121 | print "\n%upstream = (\n"; |
122 | foreach my $module (sort keys %module_to_upstream) { |
123 | my $upstream = defined $module_to_upstream{$module} |
124 | ? "'$module_to_upstream{$module}'" : 'undef'; |
125 | printf " %-24s=> $upstream,\n", "'$module'"; |
126 | } |
127 | print ");\n"; |
128 | |
129 | print "\n%bug_tracker = (\n"; |
130 | foreach my $module (sort keys %module_to_upstream) { |
131 | my $upstream = defined $module_to_upstream{$module}; |
132 | next if defined $upstream |
133 | and $upstream eq 'blead' || $upstream eq 'first-come'; |
134 | |
135 | my $bug_tracker; |
136 | |
137 | my $dist = $module_to_dist{$module}; |
138 | $bug_tracker = $dist_to_meta_YAML{$dist}->{resources}{bugtracker} |
139 | if $dist; |
140 | |
141 | $bug_tracker = defined $bug_tracker ? "'$bug_tracker'" : 'undef'; |
142 | next if $bug_tracker eq "'http://rt.perl.org/perlbug/'"; |
143 | printf " %-24s=> $bug_tracker,\n", "'$module'"; |
144 | } |
145 | print ");\n"; |