# -*-perl-*-

# $Id: Trigger.plm,v 1.5 2005/02/21 20:56:59 thomas Exp $

# This perl module implements the files component of the host configuration
# environment.

# $Log: Trigger.plm,v $
# Revision 1.5  2005/02/21 20:56:59  thomas
# Change debug levels
#
# Revision 1.4  2004/08/02 21:28:52  thomas
# Pass parameters to external commands
#
# Revision 1.3  2004/02/10 16:40:07  thomas
# pre-0.1.5 fork
#
# Revision 1.2  2003/12/15 16:28:28  thomas
# check-in for 0.1.1
#
# Revision 1.1.1.1  2003/12/02 14:47:34  thomas
# Initial version before export to 0.1.1
#

package  What::Trigger;

use strict;
use FileHandle;
use DirHandle;
use Data::Dumper;
use Text::ParseWords;

use base qw(What);

###############################################################################

sub run {
  my $trigger = shift;    # The trigger (part of $node)
  my $node    = shift;    # The config node with the attached trigger
  my $section = shift;
  my $what   = shift;    # The configuration object
  my $params  = shift;    # The trigger to be called

  my ($sname, $trigger_node, @args, $key, $result, $module, $command, $in_line, $tattrs, $useparams);
  my $path = $params->{path};
  my $nodepath = $params->{nodepath};

  # Find the trigger
  $trigger_node = $section->find_node ($section, "/Triggers/$path");
  if (!defined $trigger_node) {
    $what->err ("Trigger $path not found!\n");
    return 0;
  }

  $tattrs = $trigger_node->getattrs ($section);

  if (defined ($module = $tattrs->{module})) {
    $trigger->debug (2, "Running internal trigger $module\n");
    # The require-ing of the modules is now done in what.pl initialization
    # eval "require What::Trigger::$module;";
    # if ($@) {
    #   $what->err ("Failed to load module $module internal trigger $path.\nPerl error text follows:\n$@\n");
    #   return 0;
    # }
    $command = "\$result = What::Trigger::${module}::${module} (\$trigger, \$node, \$section, \$what, \$params);\n";
    $trigger->debug (3, "%s\n", $command);
    if ($trigger->getoption ('donothing')) {
      return 0;
    }
    eval $command;
    if ($@) {
      $what->err ("Error running internal trigger $module for trigger $path.\nPerl error text follows:\n$@\n");
      return 0;
    }
    return $result;

  } elsif (defined ($command = $tattrs->{'external-command'})) {
    $trigger->debug (2, "Running external trigger $command.\n");
    @args = ($command);
    if (defined ($tattrs->{params})) {
      foreach (split (/,/, $tattrs->{params})) {
	defined ($params->{$_}) and push @args, "--$_", $params->{$_};
      }
    }
    defined ($tattrs->{args}) and push @args, shellwords ($tattrs->{args});
    $trigger->debug (2, "%s\n", join (' ', @args));
    if ($trigger->getoption ('donothing')) {
      return 0;
    } else {
      $result = system (@args);
      return !($result>>8);
    }

  } elsif (defined ($in_line = $tattrs->{'in-line'})) {
    $trigger->debug (2, "Running in-line trigger $path.\n");
    $result=1;
    eval $in_line;
    if ($@) {
      $what->err ("Failed to execute in-line trigger $path.\nPerl error text follows:\n$@\n");
      return 0;
    }
    return $result;

  }
  $what->err ("Unkown trigger type for trigger $path -- nothing done!\n");
  return 0;
}


###############################################################################
# This routine is called during the initialization of What.  It
# Loads all the triggers, and allows each trigger to install itself in
# the /Triggers/ directories of the default section.

sub load_modules {
  my $what = shift;

  my ($section, $dh, $module, $me);

  $section = $what->find_section ('default', 1);

  $dh = new DirHandle "/s/what-0.1.31/lib/What/Trigger";
  if (defined $dh) {
    while (defined ($module = $dh->read)) {
      $module =~ s/\.pm$// or next;
      eval "require What::Trigger::$module;";
      if ($@) {
	$what->err ("Failed to load module $module internal trigger What::Trigger::$module.\nPerl error text follows:\n$@\n");
	return 0;
      } else {
	$what->debug (3, "Loaded trigger $module\n");
	$me = bless {} => "What::Trigger::$module";
	$me->init_module ($section, $what, $module);
      }
    }
  }
}

# Supply a default init_module that will install the module in the root of
# the /Triggers/ subtree.

sub init_module {
  my $self = shift;
  my $section = shift;
  my $what = shift;
  my $module = shift;

  my $class = $section->find_node ($section, '/Triggers', 1);
  $class->getoption ('donothing') and return 0;

  $self->debug (3, "Adding trigger /Triggers/$module to default section.\n");
  $section->merge (
		   $what,
		   {},
		   -1,
		   'node',
		   [
		    {
		     path => "/Triggers/$module",
		     module => "$module",
		    }
		   ]
		  );
}


###############################################################################

=head1 NAME

What::Trigger - Run a trigger

=head1 DESCRIPTION

This module contains the functionality to run a trigger.  Triggers
that are attached to other content nodes are of this type.

=cut

###############################################################################

1;
