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