package votorola::b::Function; # Copyright 2004-2005, 2007, Michael Allan.  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Votorola Software"), to deal in the Votorola Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicence, and/or sell copies of the Votorola Software, and to permit persons to whom the Votorola Software is furnished to do so, subject to the following conditions: The preceding copyright notice and this permission notice shall be included in all copies or substantial portions of the Votorola Software. THE VOTOROLA SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE VOTOROLA SOFTWARE OR THE USE OR OTHER DEALINGS IN THE VOTOROLA SOFTWARE.

use strict; use warnings;
=pod

=head1 NAME

votorola::b::Function - utilities associated with built-in Perl functions

=head1 EXPORTS

=over 4

=cut

BEGIN
{
    use Exporter ();
    our @ISA; @ISA = qw( Exporter );
    our @EXPORT_OK; @EXPORT_OK = qw( chomped exec_echo join_clean system_echo
      system_exit_decode system_or_print );
}
our @EXPORT_OK;



=pod

=item B<chomped>( $I<value> )

Returns the string without any trailing newline.
Like chomp, but does not modify the argument.

=cut

sub chomped( $ )
{
    my $value = shift;
    chomp $value;
    return $value;
}



=pod

=item B<exec_echo>( $I<command> [, $I<caption>[, $I<c>]] )

Like exec(), but prints the command prior to execution.
The print-out is underscored, and optionally captioned.
You may also specify the score character $I<c> ('^' by default).

Takes a single argument command only. Never returns. [FIX to take @, like system_or_print().]

Cf. system_echo

=cut

sub exec_echo( $;$$ )
{
    use votorola::b::Console qw( print_score );

    my $command = shift;
    my $caption = shift; defined $caption or $caption = ''; # prevent warnings
    my $c = shift; defined $c or $c = '^';

    print "\n" . $command . "\n";
    print_score( $caption, $c );
    exec( $command ) or die;
}



=pod

=item B<join_clean>( $I<separator>, I<list> )

Like join(), but no separators are inserted for null elements of the list.

=cut

sub join_clean( $@ )
{
    my $separator = shift;

    my $result = ''; # thus far
    for my $element( @_ )
    {
        $element or next;

        $result and $result .= $separator;
        $result .= $element;
    }

    return $result;
}



=pod

=item B<system_echo>( $I<command> [, $I<caption>[, $I<c>]] )

Like system(), but prints the command prior to execution.
The print-out is underscored, and optionally captioned.
You may also specify the score character $I<c> ('^' by default).

Takes a single argument command only. [FIX to take @, like system_or_print().]

Cf. exec_echo

=cut

sub system_echo( $;$$ ) # FIX to take @, like system_or_print()
{
    use votorola::b::Console qw( print_score );

    my $command = shift;
    my $caption = shift; defined $caption or $caption = ''; # prevent warnings
    my $c = shift; defined $c or $c = '^';

    print "\n" . $command . "\n";
    print_score( $caption, $c );
    my $result = system( $command );
    return $result;
}



=pod

=item B<system_exit_decode>( $I<exit_value> ) ret$

Returns the exit code of a system call.  If the call failed without a proper exit code,
returns any non-zero byte value (1 actually, but that may change).

=cut

sub system_exit_decode( $ )
{
    my $exit_value = shift;

    if( $exit_value == -1 || $exit_value & 127 ) # failed to execute, or died with signal
    {
        return 1;
    }
    else
    {
        return $exit_value >> 8;
    }
}



=pod

=item B<system_or_print>( @command )

Like system(), unless the command fails,
in which case it prints 'unable to execute:' and the command.
Use it like this, for example:

  system_or_print( "I<command_and_args>" ) and die;
  system_or_print( I<command>, I<arg>, I<arg> ) and die;

And 'die' will print your line number.

=cut

sub system_or_print( @ )
{
#   use IO::Handle qw( printflush );
    use IO::Handle qw( flush );

#   print "system_or_print: @_\n";
    my $result = system @_;
  # print "\$!=$!\n";
  # print "\$?=$?\n";
  #### if it outputs "sh: command not found", it returns 0, and no way to discover the failure! (v5.8.8)
    $result and print 'Unable to execute: ' . join( ' ', @_ ) . '. ';
    flush STDOUT;
    return $result;
}



=pod

=back

=cut

1;