#!/usr/bin/perl -w

package Opt;

use strict;
use warnings;

use Exporter 5.57 'import';
our @EXPORT = qw(%OPT $PRG %DISP);
our %OPT;
our $PRG; # basename of $0
our %DISP;

########################################
# command line arguments, option handling

my $Usage;

sub Usage(;$) {
    my $str = shift;
    if ($str) {
	print $str, "\n";
	exit 1;
    } else {
	exit 0;
    }
}

sub UsageDisp(;$) {
    my $str = shift;

    if ($str) {	print $str, "\n"; }
    my $prg = $0;
    $prg =~ s|.*/||;

    print
"Usage:
\t$prg <function> key=val ...
Available functions:
";
    for my $k (sort keys %DISP) {
	my $r = $DISP{$k};
	my ($func, $doc) = @$r;
	printf "\t%-15s %s\n", "$k:", $doc;
    }

    if ($str) {
	exit 1;
    }
    exit 0;
}

sub debug($$@) {
    my $lvl = shift;
    my $fmt = shift;

    Debug(\%OPT, $lvl, $fmt, @_);
}
sub Debug($$$@) {
    my $opt = shift;
    my $lvl = shift;
    my $fmt = shift;

    return if (!defined($$opt{debug}));
    if (
	$$opt{debug} =~ m/^\d+$/ && $$opt{debug} >= $lvl   ||
	$$opt{debug} eq $lvl
    ) {
	printf( STDERR $fmt, @_ );
    }
}

sub prg() {
    if ($0 =~ m|/([^/]*)$|) {
	$PRG = $1;
    } else {
	$PRG = $0;
    }
    $PRG;
}
sub opt(;$$@) {
    my $Usage = shift;
    my $flag = shift;
    Opt(\%OPT, $Usage, $flag, @_);
}
sub Opt($;$$@) {
    # mv each option like key=val in hash %OPT
    # if flag is set, stop at first non such option
    my $opt = shift;
    $Usage = shift // \&Usage;
    my $flag = shift // 0;
    my @argv = @_;

    my $k;
    my $v;

    if (@argv < 1) { @argv = @ARGV; }
    my @arr = ();
    while (@argv) {
	my $arg = shift @argv;
	if ($arg =~ m/=/) {
	    ($k,$v) = split(/=/, $arg, 2);
	    $$opt{$k} = $v;
	} elsif ($flag) {
	    last;
	} else {
	    push @arr, $arg;
	}
    }
    if (!$flag) {
	@argv = @arr;
    }
    prg();
    if (defined($$opt{Opt_Show})) {
	print Show($opt, "  ");
    }

    @argv;
}

sub show(;$) {
    my $a = shift;
    Show(\%OPT, $a);
}
sub Show($;$) {
    my $opt = shift;
    my $prefix = shift // "";

    my $str = "";
    for my $k (sort keys %$opt) {
	my $v = $$opt{$k};

	if (!defined($v)) {
	    $v = "undef";
	}
	$str .= sprintf("%s%-10s %s\n", $prefix, "$k:", $v);
    }
    $str;
}

sub err_count($$@) {
    my $a = shift;
    my $b = shift;
    Err_count(\%OPT, $a, $b, @_);
}
sub Err_count($$$@) {
    my $opt = shift;
    my $pfx = shift // "Please specify";
    my $count = shift // 1;
    my @keys = @_;

    my $ss = 0;
    for my $k (@keys) {
	if (defined($$opt{$k})) {
	    $ss++;
	}
    }
    if ($ss != $count) {
	&$Usage("$pfx $count arguments of " . join(", ", @keys));
    }
}

sub err_eval($$@) {
    my $a = shift;
    my $b = shift;
    Err_eval(\%OPT, $a, $b, @_);
}
sub Err_eval($$$@) {
    my $opt = shift;
    my $pfx  = shift // "Theese must be";
    my $code = shift;
    my @keys = @_;

    my @err = ();
    for my $k (@keys) {
	if (defined($$opt{$k})) {
	    if ($code) {
		my $v = $$opt{$k};
		my $isit = eval("$v $code");
		if (! $isit) {
		    push @err, "$k";
		}
	    }
	} else {
	    push @err, "$k";
	}
    }

    if (@err) {
	my $str = $pfx;
	$str .= " $code: ";
	$str .= join(", ", @err);
	&$Usage($str);
    }
}

sub disp($) {
    my $function = shift;
    if (defined($function)) {
    } else {
	&$Usage("");
    }

    my $ref = $DISP{$function};
    if (!defined($ref)) {
	UsageDisp("ERR: Unknown function: <$function>\n");
    }
    my ($func,$doc) = @{$ref};
    $func;
}


1;


