--
Linuxhotel GmbH, Geschäftsführer Dipl.-Ing. Ingo Wichmann
HRB 20463 Amtsgericht Essen, UStID DE 814 943 641
Antonienallee 1, 45279 Essen, Tel.: 0201 8536-600, http://www.linuxhotel.de
#!/usr/bin/perl
=head1 NAME
fai-deps - class dependencies for FAI
=head1 SYNOPSIS
fai-deps [-h] [--man] [-d]
=head1 ABSTRACT
implements dependencies between fai classes.
=head1 DESCRIPTION
fai-deps uses files $FAI/class/*.deps to sort the classes in
$LOGDIR/FAI_CLASSES and define additional ones. While doing so, it retains the
original order as much as possible.
*.deps files may contain class names, seperated by whitespace. Comments ( after
# or ; ) are ignored
e.g. you have a class WORDPRESS that depends on the classes VHOST and POSTGRES
. VHOST again may depend on WEBSERVER.
So if you want to install the blogging software wordpress, you add a file
$FAI/class/WORDPRESS.deps
that contains the words
VHOST
POSTGRES
and a file
$FAI/class/VHOST.deps
that contains the word
WEBSERVER
The order often is important, so this script is taking care of it. The order of
the example above would be:
WEBSERVER VHOST POSTGRES WORDPRESS
That way, in $FAI/scripts/ first the webserver would be configured, then the
vhosts, ...
It removes double entries from FAI_CLASSES and handles circular dependencies[1].
I do not recommend using circular dependencies, but if you accidentally define
them, they will not break your neck. But you'll get a warning ...
=head1 ENVIROMENT
One non-standard perl module is required:
Graph::Directed;
On debian install libgraph-perl
The following enviroment variables are used:
$LOGDIR : path to fai temporary files
$FAI : path to fai config space
=cut
BEGIN
{
unless ( $ENV{FAI} and $ENV{LOGDIR} )
{
print STDERR '$ENV{FAI} and $ENV{LOGDIR} are not defined', $/;
print STDERR 'This script should be called from within fai', $/;
exit 1;
}
}
use strict;
use warnings;
use lib "$ENV{FAI}/lib";
use Getopt::Long;
use Pod::Usage;
use Graph::Directed;
#use Text::Glob qw(match_glob);
#use Data::Dumper;
#use GraphViz;
my %opts;
GetOptions( \%opts, 'help|h', 'man', 'debug|d' ) or pod2usage(1);
pod2usage(1) if $opts{help};
pod2usage(-verbose => 2) if $opts{man};
my $debug = $opts{debug};
my $fai_classes_file = "$ENV{LOGDIR}/FAI_CLASSES";
my $class_dir = "$ENV{FAI}/class";
# main
{
# read classes and dependencies into $digraph
# retain order of first appearance in @uniq_classes
my $digraph = Graph::Directed->new;
my ( @uniq_classes ) =
read_fai_classes( $digraph, $fai_classes_file );
push @uniq_classes,
read_dependencies( $digraph, $class_dir, @uniq_classes );
exit if not $digraph->has_edges;
# debug output
if ( $debug ) {
print STDERR 'graph:', $/;
print STDERR $digraph->stringify(), $/;
print STDERR 'is strongly connected', $/
if $digraph->is_strongly_connected;
# create_graphviz_output($digraph->edges);
print STDERR 'unique list of classes, orderd by appearence', $/;
print STDERR join('-', @uniq_classes), $/;
print STDERR $/;
}
# warn if graph has cycles
if ( $digraph->has_a_cycle ) {
print STDERR 'Warning: cyclic class dependencies found:', $/;
my $copy = $digraph->copy;
while ( my @cycle = $copy->find_a_cycle ) {
print STDERR join('-', @cycle), $/;
$copy->delete_cycle(@cycle);
}
print STDERR 'I`ll try my best to retain your class order', $/;
}
# sort classes: retain order where possible, respect dependencies where
necessary
my @sorted_classes = sort_classes( $digraph, @uniq_classes );
# debug output
if ( $debug ) {
print STDERR "list of all classes after resolving
dependencies:", $/;
print STDERR "@sorted_classes", $/;
print STDERR 'in debug mode, this script has no effect at
all!', $/x5;
print STDERR 'Goodbye, and thank you for the fish', $/;
exit;
}
# rewrite $fai_classes_file
open FAI_CLASSES, ">$fai_classes_file"
or die "$!: $fai_classes_file";
print FAI_CLASSES join($/, @sorted_classes), $/;
close FAI_CLASSES;
}
exit; # end main
# sort_classes:
# topological sort classes, retaining order as much as possible
my %class_finished_for;
my @order;
sub sort_classes {
my ( $digraph, @uniq_classes ) = @_;
@order = @uniq_classes if not @order;
my @sorted_classes;
for my $class ( @uniq_classes ) {
next if exists $class_finished_for{$class};
my %unfinished_successor_for =
map { $_, 1 }
grep { not exists $class_finished_for{$_} }
successors($digraph, $class);
# retain order for successors
my @unfinished_successors =
grep { $unfinished_successor_for{$_} }
@order;
push @sorted_classes, sort_classes( $digraph,
@unfinished_successors );
push @sorted_classes, $class;
$class_finished_for{$class}++;
}
return @sorted_classes;
}
# successors: find successors for a given class
# handle circular dependencies:
# * do not return circular connected successors
# * _do_ return all successors of circular connected successors
sub successors {
my ( $digraph, $class ) = @_;
my $component =
$digraph->strongly_connected_component_by_vertex($class);
# strongly connected components to all successors, except own component
my %successor_components =
map { $_, undef } # turn list into hash for uniqueness
grep { $_ ne $component }
map { $digraph->strongly_connected_component_by_vertex($_) }
$digraph->successors($class);
# classes for these components
my %successors =
map { $_, undef } # turn list into hash for uniqueness
map { $digraph->strongly_connected_component_by_index($_) }
keys %successor_components;
return keys %successors;
}
# read_fai_classes: reads fai classes from $fai_classes_file
# usually $LOGDIR/FAI_CLASSES
sub read_fai_classes {
my ( $digraph, $fai_classes_file) = @_;
my @uniq_classes;
# read plain classes from $LOGDIR/FAI_CLASSES
open FAI_CLASSES, $fai_classes_file
or die "$!: $fai_classes_file";
while ( <FAI_CLASSES> ) {
chomp;
# skip double classes
next if $digraph->has_vertex( $_ );
push @uniq_classes, $_;
$digraph->add_vertex( $_ );
}
close FAI_CLASSES;
return @uniq_classes;
}
# read_dependencies: reads dependencies and its classes from $class_dir/*.deps
my %deps_file_seen_for;
sub read_dependencies {
my ( $digraph, $class_dir, @uniq_classes) = @_;
my @new_classes;
# read class dependencies from $class_dir/*.deps
my $prefix = quotemeta($class_dir);
my @deps_files = grep {
-f "$class_dir/$_.deps"
and not -x "$class_dir/$_.deps"
} @uniq_classes;
for my $class ( @deps_files ) {
next if $deps_file_seen_for{$class}++;
open DEPSFILE, "$class_dir/$class.deps"
or die "$!: $class";
while ( <DEPSFILE> ) {
chomp;
# remove comments, leading and trailing whitespace
s/(#|;).*// ;
s/ ^\s+ //x;
s/ \s+$ //x;
# allow multiple classes per line
my @deps = split m/\s+/;
for my $dep ( @deps ) {
push @new_classes, $dep
if not $digraph->has_vertex( $dep );
$digraph->add_edge($class, $dep);
}
}
close DEPSFILE;
push @new_classes, read_dependencies( $digraph, $class_dir,
@new_classes );
}
return @new_classes;
}
#sub create_graphviz_output {
# my @edges = @_;
# my $g = GraphViz->new();
# for ( @edges ) {
# $g->add_edge( @$_ );
# }
# return $g->as_png('graph-test.png');
#}
=head1 SEE ALSO
http://www.informatik.uni-koeln.de/fai/
=head1 AUTHOR
Copyright 2008 by Ingo Wichmann <[EMAIL PROTECTED]>
This software ist free software; you can redistribute it and/or modify
it unter the same terms as Perl itself.
=cut
