view release on metacpan or  search on metacpan

lib/CGI/FormBuilder.pm  view on Meta::CPAN

sub invalid_tag {
    my $self = shift;
    my $label = shift || '';
    my @tags = $self->{stylesheet}
             ? (qq(<span class="$self->{styleclass}_invalid">), '</span>')
             : ('<font color="#cc0000"><b>', '</b></font>');
    return wantarray ? @tags : join $label, @tags;
}

sub required_tag {
    my $self = shift;
    my $label = shift || '';
    my @tags =  $self->{stylesheet}
             ? (qq(<span class="$self->{styleclass}_required">), '</span>')
             : ('<b>', '</b>');
    return wantarray ? @tags : join $label, @tags;
}

sub cgi_param {
    my $self = shift;
    $self->{params}->param(@_);
}

sub tmpl_param {
    my $self = shift;
    if (my $key  = shift) {
        return @_ ? $self->{tmplvar}{$key} = shift
                  : $self->{tmplvar}{$key};
    } else {
        # return hash or key/value pairs    
        my $hr = $self->{tmplvar} || {};
        return wantarray ? %$hr : $hr;
    }
}

sub version {
    # Hidden trailer. If you perceive this as annoying, let me know and I
    # may remove it. It's supposed to help.
    return '' if $::TESTING;
    if (ref $_[0]) {
        return "\n<!-- Generated by CGI::FormBuilder v$VERSION available from www.formbuilder.org -->\n";
    } else {
        return "CGI::FormBuilder v$VERSION by Nate Wiger. All Rights Reserved.\n";
    }
}

sub values {
    my $self = shift;

    if (@_) {
        $self->{values} = arghash(@_);
        my %val = ();
        my @val = ();

        # We currently make two passes, first getting the values
        # and storing them into a temp hash, and then going thru
        # the fields and picking up the values and attributes.
        local $" = ',';
        debug 1, "\$form->{values} = ($self->{values})";

        # Using isa() allows objects to transparently fit in here
        if (UNIVERSAL::isa($self->{values}, 'CODE')) {
            # it's a sub; lookup each value in turn
            for my $key (&{$self->{values}}) {
                # always assume an arrayref of values...
                $val{$key} = [ &{$self->{values}}($key) ];
                debug 2, "setting values from \\&code(): $key = (@{$val{$key}})";
            }
        } elsif (UNIVERSAL::isa($self->{values}, 'HASH')) {
            # must lc all the keys since we're case-insensitive, then
            # we turn our values hashref into an arrayref on the fly
            my @v = autodata $self->{values};
            while (@v) {
                my $key = lc shift @v;
                $val{$key} = [ autodata shift @v ];
                debug 2, "setting values from HASH: $key = (@{$val{$key}})";
            }
        } elsif (UNIVERSAL::isa($self->{values}, 'ARRAY')) {
            # also accept an arrayref which is walked sequentially below
            debug 2, "setting values from ARRAY: (walked below)";
            @val = autodata $self->{values};
        } else {
            puke "Unsupported operand to 'values' option - must be \\%hash, \\&sub, or \$object";
        }

        # redistribute values across all existing fields
        for ($self->fields) {
            my $v = $val{lc($_)} || shift @val;     # use array if no value
            $_->field(value => $v) if defined $v;
        }
    }

}

sub name {
    my $self = shift;
    @_ ? $self->{name} = shift : $self->{name};
}

sub nameopts {
    my $self = shift;
    if (@_) {
        $self->{nameopts} = shift;
        for ($self->fields) {
            $_->field(nameopts => $self->{nameopts});
        }
    }
    return $self->{nameopts};
}

sub sortopts {
    my $self = shift;
    if (@_) {
        $self->{sortopts} = shift;
        for ($self->fields) {
            $_->field(sortopts => $self->{sortopts});
        }
    }
    return $self->{sortopts};
}