Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

Order your autobundle by dependency

by cbrandtbuffalo (Deacon)
on May 09, 2005 at 18:05 UTC ( [id://455259]=sourcecode: print w/replies, xml ) Need Help??
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;

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://455259]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others pondering the Monastery: (3)
As of 2024-04-19 17:41 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found