# $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@EE.Stanford.EDU)
#
# Copyright (c) 1992 Leland Stanford Jr. University Board of Trustees
#
# $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 = "/bin/mail -s '*** Message from Swatch ***'" ;
$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_message) ;
#
sub mail_it {
    local($Address, $Msg) = @_ ;

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

    open(MAIL, "| $MAILER $Address")
      || warn "$0: cannot open pipe to $MAILER: $!\n" && return ;

    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;
