# $Id: sw_actions.pl,v 2.0 1994/03/25 19:36:06 atkins Exp atkins $
#
# Action subroutines for the Swatch package
#
# Created on Mon Mar  9 23:16:26 PST 1992 (Todd.Atkins@CAST.Stanford.EDU)
# Modification history:
# date    auth  purpose
# 2/7/97  tboss hacked to read a custom subject
# 2/12/97 tboss hacked to directly use my address...cron running job can't 
#               pass my user account correctly.
# 4/3/97  tboss added donp to Addresses alias 
#
#
# Copyright (1995) The Board of Trustees of the Leland Stanford Junior
# Univeristy.  Except for commercial resale, lease, license or other commercial
# transactions, permission is hereby given to use, copy, modify, and distribute
# this software -- by exercising this permission you agree that this Notice
# shall accompany this software at all times. 
# 
# STANFORD MAKES NO REPRESENTATIONS OR WARRANTIES OF ANY KIND CONCERNING
# THIS SOFTWARE.

#
# $Log: sw_actions.pl,v $
# Revision 2.0  1994/03/25  19:36:06  atkins
# release 2.0 with RCS Id and Log messages
#
#

$BELL 	= "\007";
$MAILER = "/usr/lib/sendmail";
$WRITE 	= "/bin/write";

#
# do_bell -- send BELL(s) to the output.
#
# usage: &do_bell($number_of_bells);
#
sub do_bell {
    local($Number) = @_;

    for ( ; $Number > 0 ; $Number-- ) {
	print $BELL;
	sleep 1 if $SunTerminal;
    }
}

#
# exec_it -- fork and execute a command
#
# usage: &exec_it($command_to_execute);
#
sub exec_it {
  local($Command) = @_;

  EXECFORK: {
    if ($pid = fork) {
        return;
    } elsif (defined $pid) {
        exec($Command);
    } elsif ($! =~ /No more processes/) {
        # EAGAIN, supposedly recoverable fork error
        sleep 5;
        redo EXECFORK;
    } else {
        warn "Can't fork to exec $Command: $!\n";
    }
  }
}

#
# pipe_it -- send text to a pipe.
#
# usage: &pipe_it($program_to_pipe_to_including_the_|_symbol,
#		  $message_to_send_to_the_pipe);
# 
sub pipe_it {
    local($ProgName, $Msg) = @_;
    local($CurrentName);
    
    # open a new pipe if necessary
    if ( !$PipeOpen || $CurrentName ne $ProgName ) {
	# first close an open pipe
	close(PIPE) if $PipeOpen;
	$PipeOpen = 0;
        open(PIPE, "| $ProgName") 
             || warn "$0: cannot open pipe to $ProgName: $!\n" && return;
        $PipeOpen = 1;
        $CurrentName = $ProgName;
    }
    # send the text
    print PIPE "$Msg";
}

#
# close_pipe_if_open -- used at the end of a script to close a pipe
#	opened by &pipe_it().
#
# usage: &close_pipe_if_open();
#
sub close_pipe_if_open {
    if ($PipeOpen) {
	close(PIPE);
    }
}

# mail_it -- send some mail using $MAILER.
#
# usage: &mail_it($addresses_to_mail_to,$the_subject,$the_message);
#formercode usage: &mail_it($addresses_to_mail_to,$the_message);
#
sub mail_it {
    local($Addresses, $Subj, $Msg) = @_;
    #formercode local($Addresses, $Msg) = @_;

#testing printf("in mail_it, @_\n");
#testing printf("Addresses = $Addresses---Subj = $Subj---Msg = $Msg\n");

$Addresses = "your_address\@your.place.com"
#$Addresses = "tboss\@mail.cc.nih.gov,jmckeeby\@cc.nih.gov,donp\@cc.nih.gov";
#testing $Addresses = "tboss\@mail.cc.nih.gov";

    $Addresses =~ s/:/,/g;

    open(MAIL, "| $MAILER $Addresses")
    #testing open(MAIL, "| $MAILER tboss\@mail.cc.nih.gov")
      || warn "$0: cannot open pipe to $MAILER: $!\n" && return;

    print MAIL "To: $Addresses\n";
    #testing print MAIL "To: tboss\@mail.cc.nih.gov\n";
    print MAIL "Subject: *** $Subj *** \n\n";
    #formercode print MAIL "Subject: *** Attention *** \n\n";
    print MAIL "$Msg\n";
    close(MAIL);
}

#
# write_it -- use $WRITE to send a message logged on users.
#
# usage: &write_it($users_to_write_to,
#		   $the_message);
#
sub write_it {
    local($UserList, $Msg) = @_;

    for $User (split(/:/, $UserList)) {
	&pipe_it("$WRITE $User", $Msg);
    }
}
1;