#!/usr/bin/perl -w

package Opt;
#use Data::Dumper;

use strict;
use warnings;
use POSIX;

use Exporter 5.57 'import';
our @EXPORT_OK = qw/
   %OPT
   prg opt Opt show Show Usage debug Debug err_count Err_count err_eval Err_eval disp
/;
our %OPT; # found (by Opt()) options on command line
my $PRG = undef; # basename of $0

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

sub prg() {
    if (!defined($PRG)) {
	if ($0 =~ m|/([^/]*)$|) {
	    $PRG = $1;
	} else {
	    $PRG = $0;
	}
    }
    $PRG;
}

sub opt(;$$@) {
    my $flag = shift;
    Opt(\%OPT, $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;
    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";
	}
	push @str, sprintf("%s%-10s %s\n", $prefix, "$k:", $v);
    }
    sort @str;
}

sub Usage($$;$$) {
    my $num = shift;
    my $str = shift;
    my $usagetxt = shift;
    my $disp = shift;

    my $prg = prg();

    if ($str) {	print STDERR $str, "\n"; }
    if ($usagetxt && $str) { print STDERR "\n"; }
    if ($usagetxt) { print STDERR $usagetxt, "\n"; }

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

    exit $num;
}

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 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(undef, "$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(undef, $str);
    }
}

sub disp($$$) {
    my $function = shift;
    my $str = shift;
    my $disp = shift;

    my $ref = undef;
    if (defined($function)) {
	$ref = $$disp{$function};
    }

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

1;


