view release on metacpan or  search on metacpan

lib/Getopt/Long/CGI.pm  view on Meta::CPAN

    for(i = elements.length - 1; i >= 0; i--) {
        if (elements[i].name == en) {
            old_ele = elements[i].parentElement;
            new_ele = old_ele.cloneNode(true);
        old_ele.children[0].value = ""
            old_ele.parentElement.insertBefore(new_ele, old_ele);
            old_ele.parentElement.insertBefore(document.createElement("br"), old_ele);
            break;
        }
    }
}
END

sub _parse_key_cgi {
    my $key = shift;
    if ($key !~ m/^([\w\d\|]+)([=:][isf])?([\+!\@\%])?$/) {
        return undef; # Not sure what this is
    }
    my $name =[split('|', $1, 1)]->[0] || "";
    return wantarray ? ($name, $2, $3) : $name;
}

sub GetOptions {
    my %options = @_;

    if (not $ENV{SERVER_SOFTWARE}) {
        # Not CGI - pass upstream for normal command line handling
        return Getopt::Long::GetOptions(%options);
    }

    my $cgi = CGI->new();

    if (not $cgi->param('__getopt__')) {
        # Not a form submission, so display form
        print $cgi->header();
        print $cgi->start_html(-script => $head_js, -style => { -code => $css_style });
        print $cgi->h1($0);
        print $cgi->start_form(-method => "POST", -action => "");
        print $cgi->start_div(-id => "chooseOptions");
        print $cgi->p("Please tick the boxes for all the options you wish to set.");
        print $cgi->start_ul({-id => "chooseOptionList"});
        foreach my $key (sort keys %options) {
            my $name = _parse_key_cgi($key);
            next if not defined $name;
            print $cgi->li($cgi->checkbox(-name => "__set_$name", -onClick => "showSection(this)", -label => " $name"));
        }
        print $cgi->end_ul();
        print $cgi->p({-id => "afterList"}, "The sections below will allow you to configure your chosen options.");
        print $cgi->hr();
        print $cgi->end_div();

        foreach my $key (sort keys %options) {
            my ($name, $value_type, $modifier) = _parse_key_cgi($key);
            next if not defined $name;
            my $val = $options{$key};
            print $cgi->start_div({-id => "__opt_$name", -class => "setOption"});
            print $cgi->h2($name);

            if (($modifier || "") eq '+') {
                die "Cannot mix + and params" if $value_type;
                print $cgi->label("Value for option:", $cgi->popup_menu(-name => $name, -values => [1..9]));
            } elsif (($modifier || "") eq '!') {
                die "Cannot mix ! and params" if $value_type;
                print $cgi->checkbox(-name => $name, -checked => 1, -label => "Activate this option");
            } elsif ($value_type) {
                if (($modifier || "") eq '%' or ref($val) eq 'HASH') {
                    print $cgi->label("Value for option (key=value):", $cgi->textfield(-name => $name));
                } else {
                    print $cgi->label("Value for option:", $cgi->textfield(-name => $name));
                }
                if (($modifier || "") eq '%' or ($modifier || "") eq '@' or ref($val) eq 'ARRAY' or ref($val) eq 'HASH') {
                    print $cgi->button(-type => "button", -onClick => "cloneValue('$name')", -value => "+");
                }
            } else {
                print $cgi->checkbox(-name => $name, -label => "Activate this option", -checked => 1, -disabled => 1);
            }

            print $cgi->hr();
            print $cgi->end_div();
        }
        print $cgi->div(
            $cgi->p("Once you've configured all the options, press this button to run", $cgi->tt($0)),
            # This name is looked for on submit
            $cgi->submit(-name => '__getopt__', -value => 'Go')
        );
        print $cgi->end_form();
        print $cgi->script("hideSubsections();");
        print $cgi->end_html();
        exit(0);
    }

    # CGI form submission, so grab responses
    my %used_options = ("__getopt__" => 1);
    foreach my $key (sort keys %options) {
        my ($name, $type, $modifier) = _parse_key_cgi($key);
        next if not defined $name;
        my $val = $options{$key};
        $used_options{$name} = 1;
        $used_options{"__set_$name"} = 1;

        if (not $cgi->param("__set_$name")) {
            next;
        }

        if (($modifier || "") eq '+') {
            $$val = int($cgi->param($name)); # "Incremental" integer
        } elsif ($type) {
            my @values = $cgi->multi_param($name);
            if (($modifier || "") eq '%' or ref($val) eq 'HASH') {
                my %values = map { split /=/, $_, 2 } @values;
                if ($type =~ m/i$/) {
                    foreach my $k (keys %values) {
                        $values{$k} = int($values{$k})
                    }
                } elsif ($type =~ m/f$/) {
                    foreach my $k (keys %values) {
                        $values{$k} = 0 + $values{$k}
                    }
                }
                if (ref($val) eq 'CODE') {
                    while(my($k, $v) = each %values) {