package ExtropyUtils;

=head1 MAIN

ExtropyUtils -- Utility subroutines for extropy

=head1 SYNOPSIS

blank_line;
message("message");
message_center("message");
message_start;
press_enter;
my $user_input = prompt("Enter something");
my $user_password = prompt_password("Enter password");
my $boolean = yes("Try again?");

=head1 DESCRIPTION

This package consists of utility functions for extropy.

=head1 VERSION

0.001 (last update:  5/09/04)

=head1 AUTHOR

Chet Langin, clangin@siu.edu

SIU Plant Biotechnology and Genomics Core-facility

=head1 BUGS

None known.

=head1 SEE ALSO

extropy

=head1 COPYRIGHT

Copyright 2004, Chet Langin, All Rights Reserved.

This program is free software.  You may copy or
redistribute it under the same terms as Perl itself.

=head1 METHODS

The remainder of this document describes the methods available to the
programmer.

=cut

# load the pragmas
use warnings;
use strict;

# load modules
use Term::ReadKey;
use ExtropyConstants;

# export the subroutine names
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(blank_line
                 message
                 message_center
                 message_start
                 press_enter
                 prompt
                 prompt_password
                 yes
                );

# package variables

# ********************************  blank_line  ***************************

=head2 blank_line

Displays a blank line in the message format.

=cut  # -------------------------------------------------------------------

sub blank_line {
  message("");
} # message


# ********************************  message  ******************************

=head2 message

Displays a message.  Use message_start first.

=cut  # -------------------------------------------------------------------

sub message {
  my $message = shift;
  my $print_str = sprintf("  *  %-62s  *", $message);
  print "$print_str\n";
} # message


# ********************************  message_center  ***********************

=head2 message

Displays a centered message.  Use message_start first.

=cut  # -------------------------------------------------------------------

sub message_center {
  my $message = shift;
  my $length = length($message);
  my $padding = (62 - $length) / 2;
  for(my $lcv = 1; $lcv <= $padding; $lcv++) {
    substr($message, 0, 0) = " ";
  } # for
  my $print_str = sprintf("  *  %-62s  *", $message);
  print "$print_str\n";
} # message_center


# ********************************  message_start  ************************

=head2 message_start

Displays the header for a message.

=cut  # -------------------------------------------------------------------

sub message_start {
  print "\n\n  " .
  "********************************************************************\n";
  print "  " .
  "*                                                                  *\n";
} # message_start


# ********************************  press_enter  **************************

=head2 press_enter

Displays a message to press <ENTER> to continue.  Should be the last line
of a message.

=cut  # -------------------------------------------------------------------

sub press_enter {
  my $user_input = "";
  blank_line;
  message("Press <ENTER> when ready to proceed");
  chomp($user_input = <STDIN>);
} # message


# ********************************  prompt  *******************************

=head2 prompt

Prompts for user input.

=cut  # -------------------------------------------------------------------

sub prompt {
  my $message = shift;
  my $user_input = "";

  print "  *  $message (or Q to Quit):  \n\n  ";
  chomp($user_input = <STDIN>);
  print "\n";

  # trim the white space
  $user_input =~ s/^\s*//;
  $user_input =~ s/\s*$//;

  # check for Q
  $user_input = "Q" if($user_input eq "q");

  $user_input;
} # prompt


# ********************************  prompt_password  **********************

=head2 prompt_password

Prompts for a password.

=cut  # -------------------------------------------------------------------

sub prompt_password {
  my $message = shift;
  my $user_input = "";

  print "  *  $message (or Q to Quit):  \n\n  ";
  ReadMode 'noecho';
  chomp($user_input = <STDIN>);
  ReadMode 'normal';

  # trim the white space
  $user_input =~ s/^\s*//;
  $user_input =~ s/\s*$//;

  # check for Q
  $user_input = "Q" if($user_input eq "q");
  if($user_input eq "Q") {
    print "Q\n";
  } # if
  else {
    print "(password)\n";
  } # else

  $user_input;
} # prompt_password


# ****************************************  yes  **************************

=head2 yes("question")

Returns TRUE for yes, or FALSE for no, to a yes/no question.

=cut  # -------------------------------------------------------------------

sub yes {
  my $question = shift;
  my $user_input = "";

  while(TRUE) {
    print "  *  $question (y/n)\n\n  ";
    chomp($user_input = <STDIN>);
    print "\n";
    if($user_input =~ /^y/i) {
      return TRUE;
    } # if
    elsif($user_input =~ /^n/i) {
      return FALSE;
    } #elsif
    else {
      print "You must enter \"y\" for \"yes\" or \"n\" for \"no\".\n";
    } # else
  } # while

} # yes

1