#!/usr/bin/perl -w

package Opt;
#use Data::Dumper;

use strict;
use warnings;
use POSIX;

use Exporter 5.57 'import';
our @EXPORT_OK = qw/
   prg opt show usage debug Debug err_count err_eval disp
/;
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($;$@) {
    # 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 $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 // 0;
    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 $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 $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 $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(0, 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;