#!/usr/bin/perl

# This is a small utility for checking if the necessary Perl modules are
# installed to be able to run Captrap.

# Copyright 2009 Corey Hickey


# This file is part of Captrap.
#
# Captrap is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# Captrap is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Captrap.  If not, see <http://www.gnu.org/licenses/>.


use strict;
use warnings FATAL => 'all';

# make a list of used modules
sub mk_module_list {
  my @list = recurse_get_modules('.');
  return unique(\@list);
}


# recursively get modules from Perl files in a directory tree
sub recurse_get_modules {
  my $dir = shift;
  local *DIR;
  opendir(DIR, $dir) or die "can't opendir '$dir': $!";
  my @list;
  while (my $file = readdir(DIR)) {
    next if $file =~ /^\.{1,2}|.git|debian$/; # skip ., .., etc.
    $file = "$dir/$file";
    next if -l $file; # skip symlinks
    if (-d $file) {
      # recurse on directories
      @list = (@list, recurse_get_modules($file));
      next;
    }
    next unless -f $file; # skip non-regular files
    @list = (@list, get_modules($file));
  }
  closedir(DIR) or die "error closing '$dir': $!";
  return @list;
}


# find all the used modules in a Perl file
sub get_modules {
  my $file = shift;
  local *FILE;
  open(FILE, "<", $file) or die "can't read '$file': $!";
  my @list;
  my $first = <FILE>;
  return () unless defined($first); # empty file
  if ($first =~ /^#!.*\/perl/) {
    while(<FILE>) {
      next unless /^\s*use\s+(.*?);/;
      my $module = $1; # skip our own modules;
      next if $module =~ /^(Captrap)/;
      push(@list, $module);
    }
  }
  close(FILE) or die "error closing '$file': $!";
  return @list;
}


# remove duplicates from a list
sub unique {
  my $list = shift; # array ref
  my %seen = ();
  my @out;
  foreach my $item (@$list) {
    push(@out, $item) unless $seen{$item}++;
  }
  return \@out;
}


# try to load each module and return the reasons of any failures
sub check_modules {
  my $list = mk_module_list();
  my %failed;
  my $all_ok = 1;
  foreach my $module (@$list) {
    print "checking $module... ";
    eval "use $module";
    unless ($@) {
      print "ok\n";
      next;
    }
    print "failed\n";
    $failed{$module} = $@;
    $all_ok = 0;
  }
  print "\n\n";
  return $all_ok ? undef : \%failed;
}


# print modules that failed to load
sub print_failed {
  my $failed = shift;
  print "The following modules failed to load:\n";
  print join(" ", keys(%$failed)), "\n";
  print "\n\n";
}


# print the error messages from trying to use modules
sub print_failed_details {
  my $failed = shift;
  print "Some modules failed to load. Most likely the modules just aren't\n" .
      "installed, but check the following errors if you think a module\n" .
      "should be working.\n\n";
  while (my ($module, $reason) = each %$failed) {
    print "$module    $reason\n";
  }
}


# simple sanity check
unless (-f "util/check_deps.pl") {
  print STDERR
      "This program needs to be run from the root Captrap directory.\n" .
      "cd to that directory and run 'util/check_deps.pl\n";
}

my $failed = check_modules();
if (defined($failed)) {
  print_failed_details($failed);
  print_failed($failed);
  exit(1);
} else {
  print "All modules loaded ok.\n";
}
exit(0);