Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 207 lines (169 sloc) 6.466 kb
14fc5312 »
2010-04-12 Added whatdists.pl for Tim Bunce
1 use strict;
2 use warnings;
3 use File::Spec;
8da1587c »
2010-09-08 Changes
4 use File::Spec::Unix;
14fc5312 »
2010-04-12 Added whatdists.pl for Tim Bunce
5 use File::Fetch;
8da1587c »
2010-09-08 Changes
6 use File::Find;
1ed40293 »
2011-07-18 Skip files that don't contain a matching package declaration (with a …
7 use File::Slurp;
14fc5312 »
2010-04-12 Added whatdists.pl for Tim Bunce
8 use IO::Zlib;
e083e1b1 »
2011-01-18 Update whatdists script to only include the very latest dists that ar…
9 use CPAN::DistnameInfo;
10 use Sort::Versions;
14fc5312 »
2010-04-12 Added whatdists.pl for Tim Bunce
11 use version;
12 use Module::Load::Conditional qw[check_install];
13
8da1587c »
2010-09-08 Changes
14 use constant ON_WIN32 => $^O eq 'MSWin32';
15 use constant ON_VMS => $^O eq 'VMS';
16
8eb3cfe5 »
2013-08-03 Change mirror for whatdists.pl
17 my $mirror = 'http://www.cpan.org/';
14fc5312 »
2010-04-12 Added whatdists.pl for Tim Bunce
18
0dfbb29c »
2011-07-18 Allow dirs on the command line. Add $opt_verbose. Report File::Find e…
19 my $opt_verbose = 1;
20 my @search_dirs = (@ARGV) ? @ARGV : @INC;
21 warn "Searching @search_dirs\n" if $opt_verbose;
22
298bf87e »
2011-07-18 disambiguate the two whatdists.plseen variables
23 my %seen_dist;
14fc5312 »
2010-04-12 Added whatdists.pl for Tim Bunce
24
e083e1b1 »
2011-01-18 Update whatdists script to only include the very latest dists that ar…
25 {
14fc5312 »
2010-04-12 Added whatdists.pl for Tim Bunce
26
e083e1b1 »
2011-01-18 Update whatdists script to only include the very latest dists that ar…
27 my %installed;
28 my %cpan;
0dfbb29c »
2011-07-18 Allow dirs on the command line. Add $opt_verbose. Report File::Find e…
29 foreach my $module ( _all_installed(@search_dirs) ) {
e083e1b1 »
2011-01-18 Update whatdists script to only include the very latest dists that ar…
30 my $href = check_install( module => $module );
31 next unless $href;
32 $installed{ $module } = defined $href->{version} ? $href->{version} : 'undef';
14fc5312 »
2010-04-12 Added whatdists.pl for Tim Bunce
33 }
34
e083e1b1 »
2011-01-18 Update whatdists script to only include the very latest dists that ar…
35 my $loc = fetch_indexes('.',$mirror) or die;
36 populate_cpan( $loc, \%cpan );
37 foreach my $module ( sort keys %installed ) {
38 # Eliminate core modules
8eb3cfe5 »
2013-08-03 Change mirror for whatdists.pl
39 if ( supplied_with_core( $module ) and !$cpan{ $module } ) {
e083e1b1 »
2011-01-18 Update whatdists script to only include the very latest dists that ar…
40 delete $installed{ $module };
41 next;
42 }
43 }
44
45 # Further eliminate choices.
46
47 foreach my $mod ( sort keys %installed ) {
1ed40293 »
2011-07-18 Skip files that don't contain a matching package declaration (with a …
48
0c45a2de »
2011-07-18 Handle @INC dirs that are within other dirs (typically archlib)
49 unless ($cpan{ $mod }) {
0dfbb29c »
2011-07-18 Allow dirs on the command line. Add $opt_verbose. Report File::Find e…
50 warn "$mod not found in CPAN index (local version $installed{$mod})\n"
51 if $opt_verbose;
0c45a2de »
2011-07-18 Handle @INC dirs that are within other dirs (typically archlib)
52 next;
53 }
1ed40293 »
2011-07-18 Skip files that don't contain a matching package declaration (with a …
54
e083e1b1 »
2011-01-18 Update whatdists script to only include the very latest dists that ar…
55 my $cd = CPAN::DistnameInfo->new( $cpan{ $mod } );
298bf87e »
2011-07-18 disambiguate the two whatdists.plseen variables
56 if ( exists $seen_dist{ $cd->dist } ) {
57 my $ed = CPAN::DistnameInfo->new( $seen_dist{ $cd->dist } );
e083e1b1 »
2011-01-18 Update whatdists script to only include the very latest dists that ar…
58 if ( versioncmp( $cd->version, $ed->version ) == 1 ) {
298bf87e »
2011-07-18 disambiguate the two whatdists.plseen variables
59 $seen_dist{ $cd->dist } = $cpan{ $mod };
e083e1b1 »
2011-01-18 Update whatdists script to only include the very latest dists that ar…
60 }
61 }
62 else {
298bf87e »
2011-07-18 disambiguate the two whatdists.plseen variables
63 $seen_dist{ $cd->dist } = $cpan{ $mod };
e083e1b1 »
2011-01-18 Update whatdists script to only include the very latest dists that ar…
64 }
65 }
14fc5312 »
2010-04-12 Added whatdists.pl for Tim Bunce
66
67 }
68
298bf87e »
2011-07-18 disambiguate the two whatdists.plseen variables
69 print $_, "\n" for sort values %seen_dist;
14fc5312 »
2010-04-12 Added whatdists.pl for Tim Bunce
70 exit 0;
71
72 sub supplied_with_core {
73 my $name = shift;
74 my $ver = shift || $];
75 require Module::CoreList;
76 return $Module::CoreList::version{ 0+$ver }->{ $name };
77 }
78
79 sub _vcmp {
80 my ($x, $y) = @_;
81 s/_//g foreach $x, $y;
82 return version->parse($x) <=> version->parse($y);
83 }
84
85 sub populate_cpan {
86 my $pfile = shift;
e083e1b1 »
2011-01-18 Update whatdists script to only include the very latest dists that ar…
87 my $cpan = shift;
14fc5312 »
2010-04-12 Added whatdists.pl for Tim Bunce
88 my $fh = IO::Zlib->new( $pfile, "rb" ) or die "$!\n";
89 my %dists;
90
91 while (<$fh>) {
92 last if /^\s*$/;
93 }
94 while (<$fh>) {
95 chomp;
96 my ($module,$version,$package_path) = split ' ', $_;
e083e1b1 »
2011-01-18 Update whatdists script to only include the very latest dists that ar…
97 $cpan->{ $module } = $package_path;
14fc5312 »
2010-04-12 Added whatdists.pl for Tim Bunce
98 }
99 return 1;
100 }
101
102 sub fetch_indexes {
103 my ($location,$mirror) = @_;
104 my $packages = 'modules/02packages.details.txt.gz';
105 my $url = join '', $mirror, $packages;
106 my $ff = File::Fetch->new( uri => $url );
107 my $stat = $ff->fetch( to => $location );
108 return unless $stat;
8da1587c »
2010-09-08 Changes
109 warn "Downloaded '$url' to '$stat'\n";
14fc5312 »
2010-04-12 Added whatdists.pl for Tim Bunce
110 return $stat;
111 }
8da1587c »
2010-09-08 Changes
112
113 sub _all_installed {
0dfbb29c »
2011-07-18 Allow dirs on the command line. Add $opt_verbose. Report File::Find e…
114 my (@dirs) = @_;
115
8da1587c »
2010-09-08 Changes
116 ### File::Find uses follow_skip => 1 by default, which doesn't die
117 ### on duplicates, unless they are directories or symlinks.
118 ### Ticket #29796 shows this code dying on Alien::WxWidgets,
119 ### which uses symlinks.
120 ### File::Find doc says to use follow_skip => 2 to ignore duplicates
121 ### so this will stop it from dying.
122 my %find_args = ( follow_skip => 2 );
123
124 ### File::Find uses lstat, which quietly becomes stat on win32
125 ### it then uses -l _ which is not allowed by the statbuffer because
126 ### you did a stat, not an lstat (duh!). so don't tell win32 to
127 ### follow symlinks, as that will break badly
0c45a2de »
2011-07-18 Handle @INC dirs that are within other dirs (typically archlib)
128 # XXX disabled because we want the postprocess hook to work
129 #$find_args{'follow_fast'} = 1 unless ON_WIN32;
8da1587c »
2010-09-08 Changes
130
131 ### never use the @INC hooks to find installed versions of
132 ### modules -- they're just there in case they're not on the
133 ### perl install, but the user shouldn't trust them for *other*
134 ### modules!
135 ### XXX CPANPLUS::inc is now obsolete, remove the calls
136 #local @INC = CPANPLUS::inc->original_inc;
137
0dfbb29c »
2011-07-18 Allow dirs on the command line. Add $opt_verbose. Report File::Find e…
138 # sort @dirs to put longest first to make it easy to handle
0c45a2de »
2011-07-18 Handle @INC dirs that are within other dirs (typically archlib)
139 # elements that are within other elements (e.g., an archdir)
0dfbb29c »
2011-07-18 Allow dirs on the command line. Add $opt_verbose. Report File::Find e…
140 my @dirs_ordered = sort { length $b <=> length $a } @dirs;
0c45a2de »
2011-07-18 Handle @INC dirs that are within other dirs (typically archlib)
141
298bf87e »
2011-07-18 disambiguate the two whatdists.plseen variables
142 my %seen_mod; my @rv; my %dir_done;
0dfbb29c »
2011-07-18 Allow dirs on the command line. Add $opt_verbose. Report File::Find e…
143 for my $dir (@dirs_ordered) {
8da1587c »
2010-09-08 Changes
144 next if $dir eq '.';
145
146 ### not a directory after all
147 ### may be coderef or some such
148 next unless -d $dir;
149
150 ### make sure to clean up the directories just in case,
151 ### as we're making assumptions about the length
152 ### This solves rt.cpan issue #19738
153
154 ### John M. notes: On VMS cannonpath can not currently handle
155 ### the $dir values that are in UNIX format.
156 $dir = File::Spec->canonpath( $dir ) unless ON_VMS;
157
158 ### have to use F::S::Unix on VMS, or things will break
159 my $file_spec = ON_VMS ? 'File::Spec::Unix' : 'File::Spec';
160
161 ### XXX in some cases File::Find can actually die!
162 ### so be safe and wrap it in an eval.
163 eval { File::Find::find(
164 { %find_args,
0c45a2de »
2011-07-18 Handle @INC dirs that are within other dirs (typically archlib)
165 postprocess => sub {
166 $dir_done{ $File::Find::dir }++;
167 },
8da1587c »
2010-09-08 Changes
168 wanted => sub {
169
0c45a2de »
2011-07-18 Handle @INC dirs that are within other dirs (typically archlib)
170 unless (/\.pm$/i) {
dd01ee4d »
2011-07-18 skip all dot-dirs (eg .git .svn)
171 # skip all dot-dirs (eg .git .svn)
172 $File::Find::prune = 1 if -d $File::Find::name and /^\.\w/;
0c45a2de »
2011-07-18 Handle @INC dirs that are within other dirs (typically archlib)
173 # don't reenter a dir we've already done
174 $File::Find::prune = 1 if $dir_done{ $File::Find::name };
175 return;
176 }
8da1587c »
2010-09-08 Changes
177 my $mod = $File::Find::name;
178
179 ### make sure it's in Unix format, as it
180 ### may be in VMS format on VMS;
181 $mod = VMS::Filespec::unixify( $mod ) if ON_VMS;
182
183 $mod = substr($mod, length($dir) + 1, -3);
184 $mod = join '::', $file_spec->splitdir($mod);
185
298bf87e »
2011-07-18 disambiguate the two whatdists.plseen variables
186 return if $seen_mod{$mod}++;
8da1587c »
2010-09-08 Changes
187
d0b994b6 »
2011-07-19 make package check warning less noisy for common cases
188 ### ignore files that don't contain a matching package declaration
189 ### warn about those that do contain some kind of package declaration
1ed40293 »
2011-07-18 Skip files that don't contain a matching package declaration (with a …
190 my $content = read_file($File::Find::name);
d0b994b6 »
2011-07-19 make package check warning less noisy for common cases
191 unless ($content =~ m/^ \s* package \s+ (\#.*\n\s*)? $mod \b/xm) {
0dfbb29c »
2011-07-18 Allow dirs on the command line. Add $opt_verbose. Report File::Find e…
192 warn "No 'package $mod' seen in $File::Find::name\n"
d0b994b6 »
2011-07-19 make package check warning less noisy for common cases
193 if $opt_verbose && $content =~ /\b package \b/x;
1ed40293 »
2011-07-18 Skip files that don't contain a matching package declaration (with a …
194 return;
195 }
196
8da1587c »
2010-09-08 Changes
197 push @rv, $mod;
198 },
199 }, $dir
0dfbb29c »
2011-07-18 Allow dirs on the command line. Add $opt_verbose. Report File::Find e…
200 ); 1 }
201 or die "File::Find died: $@";
8da1587c »
2010-09-08 Changes
202
203 }
204
205 return @rv;
206 }
Something went wrong with that request. Please try again.