fai-deps

#!/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, separated 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 environment variables are used:

 $LOGDIR  : path to fai temporary files
 $FAI     : path to fai config space

=cut

INIT
  {
    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 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

 https://fai-project.org

=head1 AUTHOR

 Copyright 2008 by Ingo Wichmann <iw@linuxhotel.de>

 This software ist free software; you can redistribute it and/or modify
 it unter the same terms as Perl itself.

=cut