File Coverage

blib/lib/MDK/Common/Various.pm

Criterion	Covered	Total	%
statement	3	26	11.5
branch	0	16	0.0
condition	0	3	0.0
subroutine	1	14	7.1
pod	13	13	100.0
total	17	72	23.6

package MDK::Common::Various;

=head1 NAME

MDK::Common::Various - miscellaneous functions

=head1 SYNOPSIS

    use MDK::Common::Various qw(:all);

=head1 EXPORTS

=over

=item first(LIST)

returns the first value. C is an alternative for C<((XXX)[0])>

=item second(LIST)

returns the second value. C is an alternative for C<((XXX)[1])>

=item top(LIST)

returns the last value. C is an alternative for C<$l[$#l]>

=item to_bool(SCALAR)

returns a value in { 0, 1 }

=item to_int(STRING)

extracts the number from the string. You could use directly C, but
you'll get I. It also handles returns
11 for C<"foo 11 bar">

=item to_float(STRING)

extract a decimal number from the string

=item bool2text(SCALAR)

returns a value in { "true", "false" }

=item bool2yesno(SCALAR)

returns a value in { "yes", "no" }

=item text2bool(STRING)

inverse of C and C

=item chomp_(STRING)

non-mutable version of chomp: do not modify the argument, returns the chomp'ed
value. Also works on lists: C is equivalent to
C

=item backtrace()

returns a string describing the backtrace. eg:

    sub g { print "oops\n", backtrace() }
    sub f { &g }
    f();

gives

    oops
    main::g() called from /tmp/t.pl:2
    main::f() called from /tmp/t.pl:4


=item internal_error(STRING)

another way to C with a nice error message and a backtrace

=item noreturn()

use this to ensure nobody uses the return value of the function. eg:

    sub g { print "g called\n"; noreturn }
    sub f { print "g returns ", g() }
    f();

gives

    test.pl:3: main::f() expects a value from main::g(), but main::g() doesn't return any value

=back

=head1 SEE ALSO

L

=cut


use Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(first second top to_bool to_int to_float bool2text bool2yesno text2bool chomp_ backtrace internal_error noreturn);
our %EXPORT_TAGS = (all => [ @EXPORT_OK ]);


sub first { $_[0] }
sub second { $_[1] }
sub top { $_[-1] }

sub to_bool { $_[0] ? 1 : 0 }
sub to_int { $_[0] =~ /\s*(\d*)/ && $1 }
sub to_float { $_[0] =~ /\s*(\d*(\.\d*)?)/ && $1 }
sub bool2text { $_[0] ? "true" : "false" }
sub bool2yesno { $_[0] ? "yes" : "no" }
sub text2bool { my $t = lc($_[0]); $t eq "true" || $t eq "yes" ? 1 : 0 }

sub chomp_ { my @l = @_; chomp @l; wantarray() ? @l : $l[0] }

sub backtrace() {
    my $s;
    for (my $i = 1; caller($i); $i++) {
	my ($_package, $file, $line, $func) = caller($i);
	$s .= "$func() called from $file:$line\n";
    }
    $s;
}

sub internal_error {
    die "INTERNAL ERROR: $_[0]\n" . backtrace();
}

sub noreturn() {
    if (defined wantarray()) {
	my ($_package, $file, $line, $func) = caller(1);
	my (undef, undef, undef, $func2) = caller(2);
	die "$file:$line: $func2() expects a value from $func(), but $func() doesn't return any value\n";
    }
}

1;