use strict;
use CPAN;
use File::Basename ();
use File::Copy ();
use Getopt::Long ();
use IO::File;
my $Modules = 'Modules';
my $PerlLicense = <<EOF;
Licensed under the same terms as Perl:
http://perldoc.perl.org/perlartistic.html
http://perldoc.perl.org/perlgpl.html
EOF
my %modules = (
'Text-Balanced-2.02' => {
license => 'Perl',
licensefile => "Text-Balanced-2.02/LICENSE",
},
'Parse-RecDescent-1.965001' => {
license => 'Perl',
licensestr => $PerlLicense,
},
'Inline-0.46' => {
license => 'Perl',
licensestr => $PerlLicense,
},
'Inline-Wrapper-0.05' => {
license => 'Perl',
licensestr => $PerlLicense,
},
'Inline-Ruby-0.02' => {
license => 'Perl',
licensestr => $PerlLicense,
},
'Inline-Python-0.38' => {
license => 'Perl',
licensestr => $PerlLicense,
},
'Inline-Struct-0.06' => {
license => 'Perl',
licensestr => $PerlLicense,
},
);
my $URLprefix = 'http://search.cpan.org/CPAN/authors/id';
my $write;
Getopt::Long::GetOptions('w' => \$write);
sub importDate {
my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime;
sprintf('%d-%02d-%02d', $year + 1900, $mon + 1, $mday);
}
sub nameVers {
my $x = shift;
my @parts = split('-', $x);
my $vers = pop(@parts);
(join('-', @parts), $vers)
}
CPAN::HandleConfig->load;
CPAN::Shell::setup_output;
CPAN::Index->reload;
my($dist, $name, $vers, $url);
my($OUT, $license, $importDate);
my $today = importDate();
if($write) {
if(!-d $Modules) {
mkdir $Modules or die "Can't mkdir $Modules\n";
}
} else {
$OUT = \*STDOUT;
}
for my $m (sort(keys(%modules))) {
printf "Looking for %s\n", $m;
my($n, $v) = nameVers($m);
my $found;
my $mname = $n;
$mname =~ s/-/::/g;
for my $mod (CPAN::Shell->expand("Module", "/$mname/")) {
$dist = $mod->distribution;
next unless defined($dist);
($name, $vers) = nameVers($dist->base_id);
next unless $name eq $mname;
print " Found $name-$vers\n";
$found = $dist;
last;
}
if(!defined($found)) {
for my $dist (CPAN::Shell->expand("Distribution", "/\/$n-/")) {
($name, $vers) = nameVers($dist->base_id);
next unless $name eq $n;
print " Found $name-$vers\n";
$found = $dist;
last
}
if(!defined($found)) {
print "***Can't find $m\n";
next;
}
}
$url = $found->pretty_id;
my $base = $found->base_id;
$url =~ s/$base/$m/ unless $base eq $m;
my $a = substr($url, 0, 1);
my $a2 = substr($url, 0, 2);
$url = join('/', $URLprefix, $a, $a2, $url);
if($write) {
if(!-d "$Modules/$m") {
mkdir "$Modules/$m" or die "Can't mkdir $Modules/$m\n";
}
File::Copy::syscopy("$m.tar.gz", "$Modules/$m/$m.tar.gz") or die "Can't copy $m.tar.gz: $!\n";
$OUT = IO::File->new("$Modules/$m/Makefile", 'w');
if(!defined($OUT)) {
warn "***Can't create $Modules/$m/Makefile\n";
next;
}
} else {
if(!-f "$m.tar.gz") {
warn "No $m.tar.gz\n";
next;
}
print " Would copy $m.tar.gz\n";
print "=== $m/Makefile ===\n";
}
print $OUT <<EOF;
NAME = $name
VERSION = $vers
include ../Makefile.inc
EOF
if($write) {
undef($OUT);
$OUT = IO::File->new("$Modules/$m/oss.partial", 'w');
if(!defined($OUT)) {
warn "***Can't create $Modules/$m/oss.partial\n";
next;
}
} else {
print "=== $m/oss.partial ===\n";
}
my $h = $modules{$m};
die "$m: no license\n" unless defined($h->{license});
print $OUT <<EOF;
<dict>
<key>OpenSourceProject</key>
<string>$n</string>
<key>OpenSourceVersion</key>
<string>$v</string>
<key>OpenSourceWebsiteURL</key>
<string>http://search.cpan.org/</string>
<key>OpenSourceURL</key>
<string>$url</string>
EOF
$importDate = defined($h->{date}) ? $h->{date} : $today;
print $OUT <<EOF;
<key>OpenSourceImportDate</key>
<string>$importDate</string>
EOF
print $OUT <<EOF;
<key>OpenSourceLicense</key>
<string>$h->{license}</string>
<key>OpenSourceLicenseFile</key>
<string>CPAN.txt</string>
</dict>
EOF
if($write) {
undef($OUT);
$license = "$Modules/$m/LICENSE";
}
my @list;
if(defined($h->{licensefilelist})) {
@list = @{$h->{licensefilelist}};
} elsif(defined($h->{licensefile})) {
push(@list, $h->{licensefile});
}
if(scalar(@list) > 0) {
if(!$write) {
print "License Files:\n";
}
for(@list) {
if($write) {
system("cat $_ >> $license") == 0 or die "\"cat $_ >> $license\" failed\n";
} else {
if(!-f $_) {
warn "***No $_\n";
next;
}
print " $_\n";
}
}
} else {
die "$m: no licensestr\n" unless defined($h->{licensestr});
if($write) {
$OUT = IO::File->new($license, 'w') or die "Can't create $license\n";
print $OUT $h->{licensestr};
undef($OUT);
} else {
print "=========== License String ==========\n";
print $h->{licensestr};
print "=====================================\n";
}
}
}