view release on metacpan or  search on metacpan

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

    }
    return;
}

# CGI.pm happiness
*default  = \&value;
*defaults = \&value;
*values   = \&value;
sub value {
    my $self = shift;
    debug 2, "$self->{name}: called \$field->value(@_)";
    if (@_) {
        $self->{value} = arglist(@_);  # manually set
        delete $self->{_cache}{type};    # clear auto-type
    }
    unless ($self->force) {
        # CGI wins if stickiness is set
        debug 2, "$self->{name}: sticky && ! force";
        if (my @v = $self->cgi_value) {
            local $" = ',';
            debug 1, "$self->{name}: returning value (@v)";
            $self->inflate_value(\@v);
            return wantarray ? @v : $v[0];
        }
    }
    debug 2, "no cgi found, returning def_value";
    # no CGI value, or value was forced, or not sticky
    return $self->def_value;
}

# The value in the <tag> may be different than in code (sticky)
sub tag_value {
    my $self = shift;
    debug 2, "$self->{name}: called \$field->tag_value";
    if (@_) {
        # setting the tag_value manually is odd...
        $self->{tag_value} = arglist(@_);
        delete $self->{_cache}{type};
    }
    return $self->{tag_value} if $self->{tag_value};

    if ($self->sticky && ! $self->force) {
        # CGI wins if stickiness is set
        debug 2, "$self->{name}: sticky && ! force";
        if (my @v = $self->cgi_value) {
            local $" = ',';
            debug 1, "$self->{name}: returning value (@v)";
            return wantarray ? @v : $v[0];
        }
    }
    debug 2, "no cgi found, returning def_value";
    # no CGI value, or value was forced, or not sticky
    return $self->def_value;
}

# Handle "b:select" and "b:option"
sub tag_name {
    my $self = shift;
    $self->{tag_name} = shift if @_;
    return $self->{tag_name} if $self->{tag_name};
    # Try to guess
    my($tag) = ref($self) =~ /^CGI::FormBuilder::Field::(.+)/;
    puke "Can't resolve tag for untyped field '$self->{name}'"
        unless $tag;
    return $tag;
}

sub type {
    local $^W = 0;    # -w sucks
    my $self = shift;
    if (@_) {
        $self->{type} = lc shift;
        delete $self->{_cache}{type};   # forces rebless
        debug 2, "setting field type to '$self->{type}'";
    }

    #
    # catch for new way of saying static => 1
    #
    # confirm() will set ->static but not touch $self->{type},
    # so make sure it's not a field the user hid themselves
    #
    if ($self->static && $self->{type} ne 'hidden') {
        $self->{type} = 'static';
        delete $self->{_cache}{type};   # forces rebless
        debug 2, "setting field type to '$self->{type}'";
    }

    # manually set
    debug 2, "$self->{name}: called \$field->type (manual = '$self->{type}')";

    # The $field->type method is called so often that it really slows
    # things down. As such, we cache the type and use it *unless* the
    # value has been updated manually (we assume one CGI instance).
    # See value() for its deletion of this cache
    return $self->{_cache}{type} if $self->{_cache}{type};

    my $name = $self->{name};
    my $type;
    unless ($type = lc $self->{type}) {
        #
        # Unless the type has been set explicitly, we make a guess 
        # based on how many items there are to display, which is 
        # basically, how many options we have. Our 'jsclick' option
        # is now changed down in the javascript section, fixing a bug
        #
        if ($self->{_form}->smartness) {
            debug 1, "$name: input type not set, checking for options"; 
            if (my $n = $self->options) {
                debug 2, "$name: has options, so setting to select|radio|checkbox";
                if ($n >= $self->selectnum) {
                    debug 2, "$name: has more than selectnum (", $self->selectnum, 
                             ") options, setting to 'select'";
                    $type = 'select';
                } else {
                    # Something is a checkbox if it is a multi-valued box.
                    # However, it is *also* a checkbox if only single-valued options,
                    # otherwise you can't unselect it.
                    my @v = $self->def_value;   # only on manual, not dubious CGI
                    if ($self->multiple || @v > 1 || $n == 1) {
                        debug 2, "$name: has multiple select < selectnum, setting to 'checkbox'";
                        $type = 'checkbox';
                    } else {
                        debug 2, "$name: has singular select < selectnum, setting to 'radio'";
                        $type = 'radio';
                    }
                }
            } elsif ($self->{_form}->smartness > 1) {
                debug 2, "$name: smartness > 1, auto-inferring type based on value";
                # only autoinfer field types based on values with high smartness
                my @v = $self->def_value;   # only on manual, not dubious CGI
                if ($name =~ /passw(or)?d/i) {
                    $type = 'password';
                } elsif ($name =~ /(?:details?|comments?)$/i
                        || grep /\n|\r/, @v || $self->cols || $self->rows) {
                    $type = 'textarea';
                } elsif ($name =~ /\bfile/i) {
                    $type = 'file';
                }
            } else {
                debug 2, "no options found";
            }
        }
        $type ||= 'text';   # default if no fancy settings matched or no smartness
    }
    debug 1, "$name: field set to type '$type' (reblessing)";

    # Store type in cache for speediness
    $self->{_cache}{type} = $type;

    # Re-bless into the appropriate package
    my $pkg = __PACKAGE__ . '::' . $type;
    $pkg =~ s/\-/_/g;  # handle HTML5 type names ala 'datetime-local'
    eval "require $pkg";
    puke "Can't load $pkg for field '$name' (type '$type'): $@" if $@;
    bless $self, $pkg;

    return $type;
}

sub label {
    my $self = shift;