http://qs1969.pair.com?node_id=455259
Category: Miscellaneous
Author/Contact Info cbrandtbuffalo
Description: You can generate an autobundle from CPAN.pm easy enough, but it's in alphabetical order. This script uses some other modules to try to re-order the autobundle such that modules will be installed in the correct order so CPAN doesn't prompt you.

This is an initial step in my attempt to prepare for our perl upgrade and make it as easy as possible.

I'd really welcome some feedback if you try it out.

Update:Module::Dependency was a little cranky when I tried to install it (a few failing tests), so I forced it and it appears to work. I'll have to send something to the author.

Update:Turns out the topological sort in Graph sorts top-to-bottom, not bottom-to-top, so the list generated before was actually backwards. A simple reverse fixes the ordering.

#!/usr/local/bin/perl -w

use strict;
use Module::Dependency::Info;

# Point this to the data file you created with Module::Dependency::Ind
+exer.
# See the docs on this module for details.
# Tip: to index all of your perl files, run this (thanks merlyn):
# indexer.plx -t -b `perl -e 'print "@INC"'`

Module::Dependency::Info::setIndex( 'unified.dat' );
use Graph;
use Data::Dumper;
use Module::CoreList;

# This is your autobundle file.
open (IN, "<", "in_bundle.pm")
  or die "Can't open autobundle file.";

# This is the new autobundle file.
open (OUT, ">", "new_bundle.pm")
  or die "Can't open new bundle file.";

my $in_content = 0;
my $post_content = 0;
my @module_list;
my %module_list;

my $tail;

while( <IN> ){
  # Get start of autobundle.
  unless (/^=head1\s+CONTENTS/ or $in_content ){
    print OUT $_;
    next;
  }

  # Get tail of autobundle.
  if (/^=head1\s+CONFIGURATION/ or $post_content){
    $post_content = 1;
    $tail .= $_;
    next;
  }

  # Get the module list.
  chomp;
  $in_content = 1;

  if (/^\w+/){
    my @items = split ' ';
    $module_list{$items[0]} = $items[1];
    push @module_list, $items[0];
  }
}

# Sort the module list.

my $listref = Module::Dependency::Info::allItems();
my $g = Graph->new;

foreach my $item ( @$listref ){

  # My index had a bunch of pls and cgis, so sort them out.
  next if ($item =~ /\.pl$/);
  next if ($item =~ /\.cgi$/);

  my $childref = Module::Dependency::Info::getChildren( $item );

  foreach ( @$childref ){
    # Skip modules in core.
    # Remove this line to process core modules.
    next if ($Module::CoreList::version{ $] }{$item});
    $g->add_edge($item, $_);
  }
}

# Try to remove remaining cycles, if there are any.
my @cycle = $g->find_a_cycle;

while (@cycle){
  $cycle[1] = $cycle[0] if ( not $cycle[1] );
  print "Removing edge $cycle[0], $cycle[1] from graph to prevent cycl
+e...\n";
  $g->delete_edge($cycle[0], $cycle[1]);
  @cycle = $g->find_a_cycle;
}

my @sorted = reverse $g->topological_sort;


print OUT "=head1 CONTENTS\n\n";

foreach (@sorted){
  print OUT $_ . "\n\n" if exists $module_list{$_};
}

print OUT $tail;

close IN;
close OUT;