#!/usr/bin/perl use strict; use CPAN; use File::Basename (); use File::Copy (); use Getopt::Long (); use IO::File; my $Modules = 'Modules'; my $PerlLicense = < { 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(); #my @svncmd = qw(svn add); 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 <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 < OpenSourceProject $n OpenSourceVersion $v OpenSourceWebsiteURL http://search.cpan.org/ OpenSourceURL $url EOF $importDate = defined($h->{date}) ? $h->{date} : $today; print $OUT <OpenSourceImportDate $importDate EOF print $OUT <OpenSourceLicense $h->{license} OpenSourceLicenseFile CPAN.txt 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"; } } # if($write) { # system(@svncmd, $license, "$Modules/$m/oss.partial") == 0 or die "\"@svncmd $license $Modules/$m/oss.partial\" failed\n"; # } }