1#!/usr/bin/perl 2 3use strict; 4use CPAN; 5use File::Basename (); 6use File::Copy (); 7use File::stat (); 8use Getopt::Long (); 9use IO::File; 10 11my $Modules = 'Modules'; 12my $PerlLicense = <<EOF; 13Licensed under the same terms as Perl: 14http://perldoc.perl.org/perlartistic.html 15http://perldoc.perl.org/perlgpl.html 16EOF 17my $ArtisticLicense = <<EOF; 18http://opensource.org/licenses/artistic-license-2.0.php 19EOF 20 21my %modules = ( 22 'CPAN-Meta-2.120921' => { 23 copyright => 'This software is copyright (c) 2010 by David Golden and Ricardo Signes.', 24 license => 'Perl', 25 licensestr => $PerlLicense, 26 }, 27 'CPAN-Meta-Check-0.004' => { 28 copyright => 'This software is copyright (c) 2012 by Leon Timmermans.', 29 license => 'Perl', 30 licensestr => $PerlLicense, 31 }, 32 'CPAN-Meta-Requirements-2.122' => { 33 copyright => 'This software is copyright (c) 2010 by David Golden and Ricardo Signes.', 34 license => 'Perl', 35 licensestr => $PerlLicense, 36 }, 37 'CPAN-Meta-YAML-0.008' => { 38 copyright => 'This software is copyright (c) 2010 by Adam Kennedy.', 39 license => 'Perl', 40 licensestr => $PerlLicense, 41 }, 42 'Class-Load-XS-0.06' => { 43 copyright => 'This software is Copyright (c) 2012 by Dave Rolsky.', 44 license => 'Artistic 2.0', 45 licensestr => $ArtisticLicense, 46 }, 47 'Class-Method-Modifiers-1.10' => { 48 copyright => 'Copyright 2007-2009 Shawn M Moore.', 49 license => 'Perl', 50 licensestr => $PerlLicense, 51 }, 52 'File-Which-1.09' => { 53 copyright => 'Copyright 2002 Per Einar Ellefsen. Some parts copyright 2009 Adam Kennedy.', 54 license => 'Perl', 55 licensestr => $PerlLicense, 56 }, 57 'IO-HTML-0.04' => { 58 copyright => 'This software is copyright (c) 2012 by Christopher J. Madsen.', 59 license => 'Perl', 60 licensestr => $PerlLicense, 61 }, 62 'IPC-Run3-0.045' => { 63 copyright => 'Copyright 2003, R. Barrie Slaymaker, Jr., All Rights Reserved', 64 license => 'BSD', 65 licensestr => <<EOF, 66You may use this module under the terms of the BSD, Artistic, or GPL licenses, 67any version. 68 69See more information at: 70 71 BSD: http://www.opensource.org/licenses/bsd-license.php 72 GPL: http://www.opensource.org/licenses/gpl-license.php 73 Artistic: http://opensource.org/licenses/artistic-license.php 74EOF 75 }, 76 'Module-Implementation-0.06' => { 77 copyright => 'This software is Copyright (c) 2012 by Dave Rolsky.', 78 license => 'Artistic 2.0', 79 licensestr => $ArtisticLicense, 80 }, 81 'Module-Metadata-1.000011' => { 82 copyright => <<EOF, 83Original code Copyright (c) 2001-2011 Ken Williams. 84Additional code Copyright (c) 2010-2011 Matt Trout and David Golden. 85All rights reserved. 86EOF 87 license => 'Perl', 88 licensestr => $PerlLicense, 89 }, 90 'Moo-1.000005' => { 91 copyright => 'Copyright (c) 2010-2011 the Moo "AUTHOR" and "CONTRIBUTORS" as listed above.', 92 license => 'Perl', 93 licensestr => $PerlLicense, 94 }, 95 'Probe-Perl-0.01' => { 96 copyright => 'Copyright (C) 2005 Randy W. Sims', 97 license => 'Perl', 98 licensestr => $PerlLicense, 99 }, 100 'Role-Tiny-1.002001' => { 101 copyright => <<'EOC', 102Copyright (c) 2010-2012 the Role::Tiny 103mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk> 104dg - David Leadbeater (cpan:DGL) <dgl@dgl.cx> 105frew - Arthur Axel "fREW" Schmidt (cpan:FREW) <frioux@gmail.com> 106hobbs - Andrew Rodland (cpan:ARODLAND) <arodland@cpan.org> 107jnap - John Napiorkowski (cpan:JJNAPIORK) <jjn1056@yahoo.com> 108ribasushi - Peter Rabbitson (cpan:RIBASUSHI) <ribasushi@cpan.org> 109chip - Chip Salzenberg (cpan:CHIPS) <chip@pobox.com> 110ajgb - Alex J. G. Burzyński (cpan:AJGB) <ajgb@cpan.org> 111doy - Jesse Luehrs (cpan:DOY) <doy at tozt dot net> 112perigrin - Chris Prather (cpan:PERIGRIN) <chris@prather.org> 113Mithaldu - Christian Walde (cpan:MITHALDU) 114<walde.christian@googlemail.com> 115ilmari - Dagfinn Ilmari Mannsåker (cpan:ILMARI) <ilmari@ilmari.org> 116tobyink - Toby Inkster (cpan:TOBYINK) <tobyink@cpan.org> 117EOC 118 license => 'Perl', 119 licensestr => $PerlLicense, 120 }, 121 'Sub-Exporter-Progressive-0.001006' => { 122 copyright => <<'EOC', 123Copyright (c) 2012 the Sub::Exporter::Progressive 124frew - Arthur Axel Schmidt (cpan:FREW) <frioux+cpan@gmail.com> 125ilmari - Dagfinn Ilmari Mannsåker (cpan:ILMARI) <ilmari@ilmari.org> 126mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk> 127leont - Leon Timmermans (cpan:LEONT) <leont@cpan.org> 128EOC 129 license => 'Perl', 130 licensestr => $PerlLicense, 131 }, 132 'Syntax-Keyword-Junction-0.003001' => { 133 copyright => 'This software is copyright (c) 2012 by Arthur Axel "fREW" Schmidt.', 134 license => 'Perl', 135 licensestr => $PerlLicense, 136 }, 137 'Test-CheckDeps-0.002' => { 138 copyright => 'This software is copyright (c) 2011 by Leon Timmermans', 139 license => 'Perl', 140 licensestr => $PerlLicense, 141 }, 142 'Test-Script-1.07' => { 143 copyright => 'Copyright 2006 - 2009 Adam Kennedy.', 144 license => 'Perl', 145 licensestr => $PerlLicense, 146 }, 147 'Test-Trap-v0.2.2' => { 148 copyright => 'Copyright (C) 2006-2012 Eirik Berg Hanssen', 149 license => 'Perl', 150 licensestr => $PerlLicense, 151 }, 152 'XML-SAX-Expat-0.40' => { 153 copyright => 'Copyright (c) 2001-2008 Robin Berjon. All rights reserved.', 154 license => 'Perl', 155 licensestr => $PerlLicense, 156 }, 157 'strictures-1.004002' => { 158 copyright => 'Copyright (c) 2010 mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>', 159 license => 'Perl', 160 licensestr => $PerlLicense, 161 }, 162 'syntax-0.004' => { 163 copyright => "This software is copyright (c) 2012 by Robert 'phaylon' Sedlacek.", 164 license => 'Perl', 165 licensestr => $PerlLicense, 166 }, 167); 168 169my $URLprefix = 'http://search.cpan.org/CPAN/authors/id'; 170 171my $opensource; # output opensource copyright and license info 172my $write; 173Getopt::Long::GetOptions('o' => \$opensource, 'w' => \$write); 174 175sub importDate { 176 my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = scalar(@_) > 0 ? localtime(shift) : localtime; 177 sprintf('%d-%02d-%02d', $year + 1900, $mon + 1, $mday); 178} 179 180sub nameVers { 181 my $x = shift; 182 my @parts = split('-', $x); 183 my $vers = pop(@parts); 184 (join('-', @parts), $vers) 185} 186 187if($opensource) { 188 # Legal now says that the full text of the license file is not needed, if 189 # it is just one of the standard licenses. Next time we update CPAN, we 190 # should use licensefile more sparingly. 191 for my $m (sort(keys(%modules))) { 192 print "******** $m ********\n"; 193 my $h = $modules{$m}; 194 my @list; 195 if(defined($h->{licensefilelist})) { 196 @list = @{$h->{licensefilelist}}; 197 } elsif(defined($h->{licensefile})) { 198 push(@list, $h->{licensefile}); 199 } 200 die "$m: no copyright\n" unless defined($h->{copyright}); 201 chomp($h->{copyright}); 202 if(length($h->{copyright}) > 0) { 203 print "$h->{copyright}\n\n"; 204 } elsif(scalar(@list) <= 0) { 205 die "$m: copyright empty and no licence file\n"; 206 } 207 if(scalar(@list) > 0) { 208 for(@list) { 209 system("cat $_") == 0 or die "\"cat $_\" failed\n"; 210 print "\n"; 211 } 212 } else { 213 die "$m: no licensestr\n" unless defined($h->{licensestr}); 214 chomp($h->{licensestr}); 215 print "$h->{licensestr}\n\n"; 216 } 217 } 218 exit(0); 219} 220 221CPAN::HandleConfig->load; 222CPAN::Shell::setup_output; 223CPAN::Index->reload; 224 225my($dist, $name, $vers, $url); 226my($OUT, $license, $importDate); 227#my @svncmd = qw(svn add); 228 229if($write) { 230 if(!-d $Modules) { 231 mkdir $Modules or die "Can't mkdir $Modules\n"; 232 } 233} else { 234 $OUT = \*STDOUT; 235} 236 237my $tardir = '.'; 238$tardir = $ARGV[0] if scalar(@ARGV) > 0; 239for my $m (sort(keys(%modules))) { 240 printf "Looking for %s\n", $m; 241 my($n, $v) = nameVers($m); 242 my $found; 243 my $mname = $n; 244 $mname =~ s/-/::/g; 245 for my $mod (CPAN::Shell->expand("Module", "/$mname/")) { 246 $dist = $mod->distribution; 247 next unless defined($dist); 248 ($name, $vers) = nameVers($dist->base_id); 249 next unless $name eq $mname; 250 print " Found $name-$vers\n"; 251 $found = $dist; 252 last; 253 } 254 if(!defined($found)) { 255 for my $dist (CPAN::Shell->expand("Distribution", "/\/$n-/")) { 256 ($name, $vers) = nameVers($dist->base_id); 257 next unless $name eq $n; 258 print " Found $name-$vers\n"; 259 $found = $dist; 260 last 261 } 262 if(!defined($found)) { 263 print "***Can't find $m\n"; 264 next; 265 } 266 } 267 $url = $found->pretty_id; 268 my $base = $found->base_id; 269 $url =~ s/$base/$m/ unless $base eq $m; 270 my $a = substr($url, 0, 1); 271 my $a2 = substr($url, 0, 2); 272 $url = join('/', $URLprefix, $a, $a2, $url); 273 my $t = File::Spec->join($tardir, "$m.tar.gz"); 274 if($write) { 275 if(!-d "$Modules/$m") { 276 mkdir "$Modules/$m" or die "Can't mkdir $Modules/$m\n"; 277 } 278 File::Copy::syscopy($t, "$Modules/$m/$m.tar.gz") or die "Can't copy $t: $!\n"; 279 $OUT = IO::File->new("$Modules/$m/Makefile", 'w'); 280 if(!defined($OUT)) { 281 warn "***Can't create $Modules/$m/Makefile\n"; 282 next; 283 } 284 } else { 285 if(!-f $t) { 286 warn "No $t\n"; 287 next; 288 } 289 print " Would copy $t\n"; 290 print "=== $m/Makefile ===\n"; 291 } 292 293 print $OUT <<EOF; 294NAME = $name 295VERSION = $vers 296 297include ../Makefile.inc 298EOF 299 if($write) { 300 undef($OUT); 301 $OUT = IO::File->new("$Modules/$m/oss.partial", 'w'); 302 if(!defined($OUT)) { 303 warn "***Can't create $Modules/$m/oss.partial\n"; 304 next; 305 } 306 } else { 307 print "=== $m/oss.partial ===\n"; 308 } 309 my $h = $modules{$m}; 310 die "$m: no license\n" unless defined($h->{license}); 311 print $OUT <<EOF; 312<dict> 313 <key>OpenSourceProject</key> 314 <string>$n</string> 315 <key>OpenSourceVersion</key> 316 <string>$v</string> 317 <key>OpenSourceWebsiteURL</key> 318 <string>http://search.cpan.org/</string> 319 <key>OpenSourceURL</key> 320 <string>$url</string> 321EOF 322 my $stat = File::stat::stat($t); 323 $importDate = defined($h->{date}) ? $h->{date} : importDate($stat->mtime); 324 print $OUT <<EOF; 325 <key>OpenSourceImportDate</key> 326 <string>$importDate</string> 327EOF 328 print $OUT <<EOF; 329 <key>OpenSourceLicense</key> 330 <string>$h->{license}</string> 331 <key>OpenSourceLicenseFile</key> 332 <string>CPAN.txt</string> 333</dict> 334EOF 335 if($write) { 336 undef($OUT); 337 $license = "$Modules/$m/LICENSE"; 338 } 339 my @list; 340 if(defined($h->{licensefilelist})) { 341 @list = @{$h->{licensefilelist}}; 342 } elsif(defined($h->{licensefile})) { 343 push(@list, $h->{licensefile}); 344 } 345 if(scalar(@list) > 0) { 346 if(!$write) { 347 print "License Files:\n"; 348 } 349 for(@list) { 350 if($write) { 351 system("cat $_ >> $license") == 0 or die "\"cat $_ >> $license\" failed\n"; 352 } else { 353 if(!-f $_) { 354 warn "***No $_\n"; 355 next; 356 } 357 print " $_\n"; 358 } 359 } 360 } else { 361 die "$m: no licensestr\n" unless defined($h->{licensestr}); 362 if($write) { 363 $OUT = IO::File->new($license, 'w') or die "Can't create $license\n"; 364 print $OUT $h->{licensestr}; 365 undef($OUT); 366 } else { 367 print "=========== License String ==========\n"; 368 print $h->{licensestr}; 369 print "=====================================\n"; 370 } 371 } 372# if($write) { 373# system(@svncmd, $license, "$Modules/$m/oss.partial") == 0 or die "\"@svncmd $license $Modules/$m/oss.partial\" failed\n"; 374# } 375} 376