new option -dists

eserte · Nov 6, 2015 · 5976ac1 · 5976ac1
1 parent 210df76
commit 5976ac1
Showing 1 changed file with 31 additions and 22 deletions.
diff --git a/utils/create_modlist_by_years.pl b/utils/create_modlist_by_years.pl
@@ -16,9 +16,11 @@
 
 my @perls;
 my $years_range_in;
+my $output_dists;
 GetOptions('perl=s@' => \@perls,
 	   "years=s" => \$years_range_in,
-	  ) or die "usage?";
+	   'dists'   => \$output_dists,
+	  ) or die "usage: $0 [-dists] -perl /path/to/perl [-perl ...] -years YYYY.. | -years YYYY..YYYY\n";
 sub usage_years_range () { die "Please specify years range in the form -years YYYY..YYYY or -years YYYY.." }
 $years_range_in or usage_years_range;
 @perls or die "Please specify -perl /path/to/perl";
@@ -113,39 +115,46 @@
     close $ifh
 	or die $!;
 
-    my %seen;
+    my %seen; # package or distribution
     for my $date_dist (sort { $b->[0] cmp $a->[0] } values %date_dists) {# sort by date, newest first
 	my(@fields) = @$date_dist;
 	my $dist = $fields[1];
 	next if $dangerous{$dist};
 	if ($dist =~ m{^(.)(.)}) {
 	    $dist = "$1/$1$2/$dist";
 	    if (my $dist_o = eval { $pf->distribution($dist) }) {
-		# Translate distname into the best module name
-		my $primary_package;
+		if ($output_dists) {
+		    my $distname = $dist_o->cpanid . '/' . $dist_o->filename;
+		    if (!$seen{$distname}++) {
+			print $distname, "\n";
+		    }
+		} else {
+		    # Translate distname into the best module name
+		    my $primary_package;
 
-		my $maybe_primary_package = $dist_o->dist;
-		$maybe_primary_package =~ s{-}{::}g; # e.g. ExtUtils-MakeMaker -> ExtUtils::MakeMaker
+		    my $maybe_primary_package = $dist_o->dist;
+		    $maybe_primary_package =~ s{-}{::}g; # e.g. ExtUtils-MakeMaker -> ExtUtils::MakeMaker
 
-		my @packages;
-		for my $contains ($dist_o->contains) {
-		    my $package = $contains->package;
-		    if ($package eq $maybe_primary_package) {
-			$primary_package = $package;
-			last;
+		    my @packages;
+		    for my $contains ($dist_o->contains) {
+			my $package = $contains->package;
+			if ($package eq $maybe_primary_package) {
+			    $primary_package = $package;
+			    last;
+			}
+			push @packages, $package;
 		    }
-		    push @packages, $package;
-		}
 
-		if (!defined $primary_package) {
-		    # find shortest module here
-		    # XXX Bundles should get a lower priority XXX
-		    @packages = sort { length($a) <=> length($b) } @packages;
-		    $primary_package = $packages[0];
-		}
+		    if (!defined $primary_package) {
+			# find shortest module here
+			# XXX Bundles should get a lower priority XXX
+			@packages = sort { length($a) <=> length($b) } @packages;
+			$primary_package = $packages[0];
+		    }
 
-		if (!$seen{$primary_package}++) {
-		    print $primary_package, "\n";
+		    if (!$seen{$primary_package}++) {
+			print $primary_package, "\n";
+		    }
 		}
 	    }
 	}