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