1#!/usr/bin/perl 2 3# genNewOSS.pl 4# 5# genNewOSS.pl, given a list of modules + metadata and corresponding tarballs 6# (downloaded via getCPAN.pl), creates a Modules subdirectory containing 7# subdirectories with the tarball, Makefile, LICENSE and oss.partial (querying 8# the CPAN servers for OSS information), suitable to be used in the CPAN 9# project's Modules directory. 10# 11# By default, genNewOSS.pl prints out what it would do; use the -w option to 12# actually create the subdirectories and write the files. The tarballs are 13# expected to be in the current directory, or else the path of the directory 14# containing the tarballs can be passed on the command line. 15# 16# The -o options prints out all the opensource licensing info, useful for 17# including in an opensource approval request. 18# 19# The %modules hash should be modified to specify metadata for the modules. 20# The versioned module name is the hash key, and the value is a hash reference 21# containing three key/value pair. The "copyright" key points to a string 22# containing copyright information about the module, while the "license" 23# key points to a string giving the license name. 24# 25# The third key/value pair can be any one of the following: 26# 27# licensestr => string specifying the license terms 28# licensefile => string containing path to a file containing license terms 29# licensefilelist => list reference containing multiple path string to files 30# containing license terms 31# 32# (licensing term can be a URL where the terms are stated) 33 34use strict; 35use CPAN; 36use File::Basename (); 37use File::Copy (); 38use File::stat (); 39use Getopt::Long (); 40use IO::File; 41 42my $Modules = 'Modules'; 43my $PerlLicense = <<EOF; 44Licensed under the same terms as Perl: 45http://perldoc.perl.org/perlartistic.html 46http://perldoc.perl.org/perlgpl.html 47EOF 48my $ArtisticLicense = <<EOF; 49http://opensource.org/licenses/Artistic-2.0 50EOF 51my $Apache20License = <<EOF; 52http://www.apache.org/licenses/LICENSE-2.0 53EOF 54 55my %modules = ( 56 'Capture-Tiny-0.23' => { 57 copyright => 'This software is Copyright (c) 2009 by David Golden.', 58 license => 'Apache 2.0', 59 licensestr => $Apache20License, 60 }, 61 'Class-Tiny-0.014' => { 62 copyright => 'This software is Copyright (c) 2013 by David Golden.', 63 license => 'Apache 2.0', 64 licensestr => $Apache20License, 65 }, 66 'Devel-StackTrace-1.31' => { 67 copyright => 'This software is Copyright (c) 2014 by Dave Rolsky.', 68 license => 'ArtisticLicense', 69 licensestr => $ArtisticLicense, 70 }, 71 'ExtUtils-Config-0.007' => { 72 copyright => 'This software is copyright (c) 2006 by Ken Williams, Leon Timmermans.', 73 license => 'Perl', 74 licensestr => $PerlLicense, 75 }, 76 'ExtUtils-Helpers-0.021' => { 77 copyright => 'This software is copyright (c) 2004 by Ken Williams, Leon Timmermans.', 78 license => 'Perl', 79 licensestr => $PerlLicense, 80 }, 81 'ExtUtils-InstallPaths-0.010' => { 82 copyright => 'This software is copyright (c) 2011 by Ken Williams, Leon Timmermans.', 83 license => 'Perl', 84 licensestr => $PerlLicense, 85 }, 86 'Import-Into-1.002000' => { 87 copyright => 'Copyright (c) 2012 mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>, haarg - Graham Knop (cpan:HAARG) <haarg@haarg.org>', 88 license => 'Perl', 89 licensestr => $PerlLicense, 90 }, 91 'Lexical-SealRequireHints-0.007' => { 92 copyright => 'Copyright (C) 2009, 2010, 2011, 2012 Andrew Main (Zefram) <zefram@fysh.org>', 93 license => 'Perl', 94 licensestr => $PerlLicense, 95 }, 96 'Module-Build-Tiny-0.034' => { 97 copyright => 'This software is copyright (c) 2011 by Leon Timmermans, David Golden.', 98 license => 'Perl', 99 licensestr => $PerlLicense, 100 }, 101 'bareword-filehandles-0.003' => { 102 copyright => 'This software is copyright (c) 2011 by Dagfinn Ilmari Mannsåker.', 103 license => 'Perl', 104 licensestr => $PerlLicense, 105 }, 106 'indirect-0.31' => { 107 copyright => 'Copyright 2008,2009,2010,2011,2012,2013 Vincent Pit, all rights reserved.', 108 license => 'Perl', 109 licensestr => $PerlLicense, 110 }, 111 'multidimensional-0.011' => { 112 copyright => 'This software is copyright (c) 2010 by Dagfinn Ilmari Mannsåker.', 113 license => 'Perl', 114 licensestr => $PerlLicense, 115 }, 116); 117 118my $URLprefix = 'http://search.cpan.org/CPAN/authors/id'; 119 120my $opensource; # output opensource copyright and license info 121my $write; 122Getopt::Long::GetOptions('o' => \$opensource, 'w' => \$write); 123 124sub importDate { 125 my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = scalar(@_) > 0 ? localtime(shift) : localtime; 126 sprintf('%d-%02d-%02d', $year + 1900, $mon + 1, $mday); 127} 128 129sub nameVers { 130 my $x = shift; 131 my @parts = split('-', $x); 132 my $vers = pop(@parts); 133 (join('-', @parts), $vers) 134} 135 136if($opensource) { 137 # Legal now says that the full text of the license file is not needed, if 138 # it is just one of the standard licenses. Next time we update CPAN, we 139 # should use licensefile more sparingly. 140 for my $m (sort(keys(%modules))) { 141 print "******** $m ********\n"; 142 my $h = $modules{$m}; 143 my @list; 144 if(defined($h->{licensefilelist})) { 145 @list = @{$h->{licensefilelist}}; 146 } elsif(defined($h->{licensefile})) { 147 push(@list, $h->{licensefile}); 148 } 149 die "$m: no copyright\n" unless defined($h->{copyright}); 150 chomp($h->{copyright}); 151 if(length($h->{copyright}) > 0) { 152 print "$h->{copyright}\n\n"; 153 } elsif(scalar(@list) <= 0) { 154 die "$m: copyright empty and no licence file\n"; 155 } 156 if(scalar(@list) > 0) { 157 for(@list) { 158 system("cat $_") == 0 or die "\"cat $_\" failed\n"; 159 print "\n"; 160 } 161 } else { 162 die "$m: no licensestr\n" unless defined($h->{licensestr}); 163 chomp($h->{licensestr}); 164 print "$h->{licensestr}\n\n"; 165 } 166 } 167 exit(0); 168} 169 170CPAN::HandleConfig->load; 171CPAN::Shell::setup_output; 172CPAN::Index->reload; 173 174my($dist, $name, $vers, $url); 175my($OUT, $license, $importDate); 176#my @svncmd = qw(svn add); 177 178if($write) { 179 if(!-d $Modules) { 180 mkdir $Modules or die "Can't mkdir $Modules\n"; 181 } 182} else { 183 $OUT = \*STDOUT; 184} 185 186my $tardir = '.'; 187$tardir = $ARGV[0] if scalar(@ARGV) > 0; 188for my $m (sort(keys(%modules))) { 189 printf "Looking for %s\n", $m; 190 my($n, $v) = nameVers($m); 191 my $found; 192 my $mname = $n; 193 $mname =~ s/-/::/g; 194 for my $mod (CPAN::Shell->expand("Module", "/$mname/")) { 195 $dist = $mod->distribution; 196 next unless defined($dist); 197 ($name, $vers) = nameVers($dist->base_id); 198 next unless $name eq $mname; 199 next unless $vers eq $v; 200 print " Found $name-$vers\n"; 201 $found = $dist; 202 last; 203 } 204 if(!defined($found)) { 205 for my $dist (CPAN::Shell->expand("Distribution", "/\/$n-/")) { 206 ($name, $vers) = nameVers($dist->base_id); 207 next unless $name eq $n; 208 next unless $vers eq $v; 209 print " Found $name-$vers\n"; 210 $found = $dist; 211 last 212 } 213 if(!defined($found)) { 214 print "***Can't find $m\n"; 215 next; 216 } 217 } 218 $url = $found->pretty_id; 219 my $base = $found->base_id; 220 $url =~ s/$base/$m/ unless $base eq $m; 221 my $a = substr($url, 0, 1); 222 my $a2 = substr($url, 0, 2); 223 $url = join('/', $URLprefix, $a, $a2, $url); 224 my $t = File::Spec->join($tardir, "$m.*"); 225 my @t = glob($t); 226 die "\"$t\" produces no matches\n" if scalar(@t) == 0; 227 die "\"$t\" produces multiple matches\n" if scalar(@t) > 1; 228 $t = $t[0]; 229 my($tail, $dir, $suf) = File::Basename::fileparse($t, qr/\.(tar\.gz|tgz)/); 230 die "$t has unknown suffix\n" if $suf eq ''; 231 if($write) { 232 if(!-d "$Modules/$m") { 233 mkdir "$Modules/$m" or die "Can't mkdir $Modules/$m\n"; 234 } 235 File::Copy::syscopy($t, "$Modules/$m/$tail$suf") or die "Can't copy $t: $!\n"; 236 $OUT = IO::File->new("$Modules/$m/Makefile", 'w'); 237 if(!defined($OUT)) { 238 warn "***Can't create $Modules/$m/Makefile\n"; 239 next; 240 } 241 } else { 242 if(!-f $t) { 243 warn "No $t\n"; 244 next; 245 } 246 print " Would copy $t\n"; 247 print "=== $m/Makefile ===\n"; 248 } 249 250 print $OUT <<EOF; 251NAME = $name 252VERSION = $vers 253 254include ../Makefile.inc 255EOF 256 if($suf ne '.tar.gz') { 257 print $OUT <<EOF; 258 259TARBALL := \$(NAMEVERSION)$suf 260EOF 261 } 262 if($write) { 263 undef($OUT); 264 $OUT = IO::File->new("$Modules/$m/oss.partial", 'w'); 265 if(!defined($OUT)) { 266 warn "***Can't create $Modules/$m/oss.partial\n"; 267 next; 268 } 269 } else { 270 print "=== $m/oss.partial ===\n"; 271 } 272 my $h = $modules{$m}; 273 die "$m: no license\n" unless defined($h->{license}); 274 print $OUT <<EOF; 275<dict> 276 <key>OpenSourceProject</key> 277 <string>$n</string> 278 <key>OpenSourceVersion</key> 279 <string>$v</string> 280 <key>OpenSourceWebsiteURL</key> 281 <string>http://search.cpan.org/</string> 282 <key>OpenSourceURL</key> 283 <string>$url</string> 284EOF 285 my $stat = File::stat::stat($t); 286 $importDate = defined($h->{date}) ? $h->{date} : importDate($stat->mtime); 287 print $OUT <<EOF; 288 <key>OpenSourceImportDate</key> 289 <string>$importDate</string> 290EOF 291 print $OUT <<EOF; 292 <key>OpenSourceLicense</key> 293 <string>$h->{license}</string> 294 <key>OpenSourceLicenseFile</key> 295 <string>CPAN.txt</string> 296</dict> 297EOF 298 if($write) { 299 undef($OUT); 300 $license = "$Modules/$m/LICENSE"; 301 } 302 my @list; 303 if(defined($h->{licensefilelist})) { 304 @list = @{$h->{licensefilelist}}; 305 } elsif(defined($h->{licensefile})) { 306 push(@list, $h->{licensefile}); 307 } 308 if(scalar(@list) > 0) { 309 if(!$write) { 310 print "License Files:\n"; 311 } 312 for(@list) { 313 if($write) { 314 system("cat $_ >> $license") == 0 or die "\"cat $_ >> $license\" failed\n"; 315 } else { 316 if(!-f $_) { 317 warn "***No $_\n"; 318 next; 319 } 320 print " $_\n"; 321 } 322 } 323 } else { 324 die "$m: no licensestr\n" unless defined($h->{licensestr}); 325 if($write) { 326 $OUT = IO::File->new($license, 'w') or die "Can't create $license\n"; 327 print $OUT $h->{licensestr}; 328 undef($OUT); 329 } else { 330 print "=========== License String ==========\n"; 331 print $h->{licensestr}; 332 print "=====================================\n"; 333 } 334 } 335# if($write) { 336# system(@svncmd, $license, "$Modules/$m/oss.partial") == 0 or die "\"@svncmd $license $Modules/$m/oss.partial\" failed\n"; 337# } 338} 339