Name

select —

DESCRIPTION

EXAMPLES

No examples are available at this time. We do consider this a problem and will try to supply some.

NOTES

AVAILABILITY

select is available in Interchange versions:

4.6.0-5.7.0 (git-head)

SOURCE

Interchange 5.7.0:

Source: code/Widget/select.widget
Lines: 13


# Copyright 2005-2007 Interchange Development Group and others
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.  See the LICENSE file for details.
# 
# $Id: select.widget,v 1.3 2007-03-30 23:40:58 pajamian Exp $

CodeDef select Widget 1
CodeDef select Description Select box
CodeDef select Help AKA dropdown menu
CodeDef select MapRoutine Vend::Form::dropdown

Source: lib/Vend/Form.pm
Lines: 863

sub dropdown {
my($opt, $opts) = @_;
#::logDebug("called select opt=" . ::uneval($opt) . "\nopts=" . ::uneval($opts));
$opt->{multiple} = 1 if $opt->{type} eq 'multiple';

$opts ||= [];

my $price = $opt->{price} || {};

my $select;
#::logDebug("template for selecthead: $Template{selecthead}");
#::logDebug("opt is " . ::uneval($opt));
my $run = attr_list($Template{selecthead}, $opt);
#::logDebug("run is now: $run");
my ($multi, $re_b, $re_e, $regex);
#::logDebug("select multiple=$opt->{multiple}");
if($opt->{multiple}) {
  $multi = 1;
  if($opt->{rawvalue}) {
    $re_b = '(?:\0|^)';
    $re_e = '(?:\0|$)';
  }
  else {
    $re_b = '(?:[\0,\s]|^)';
    $re_e = '(?:[\0,\s]|$)';
  }
}
else {
  $re_b = '^';
  $re_e = '$';
}

my $limit;
if($opt->{cols}) {
  my $cols = $opt->{cols};
  $limit = sub {
    return $_[0] if length($_[0]) <= $cols;
    return substr($_[0], 0, $cols - 2) . '..';
  };
}
else {
  $limit = sub { return $_[0] };
}

my $default = $opt->{value};

my $optgroup_one;
my $no_encode = $opt->{pre_filter} eq 'decode_entities' ? 1 : 0;

for(@$opts) {
  my ($value, $label, $help) = @$_;
  encode($label, $ESCAPE_CHARS::std) unless $no_encode;
  encode($help, $ESCAPE_CHARS::std) if $help;
  if($value =~ /^\s*\~\~(.*)\~\~\s*$/) {
    my $label = $1;
    if($optgroup_one++) {
      $run .= "</optgroup>";
    }
    $run .= qq{<optgroup label="$label">};
    next;
  }
  $run .= '<option';
  $select = '';

  if($label) {
    $label =~ s/\*$// and $select = 1;
  }
  else {
    $value =~ s/\*$// and $select = 1;
  }

  $select = '' if defined $default;

  my $extra = '';
  my $attr = {};
  if(my $p = $price->{$value}) {
    $attr->{negative} = $p < 0 ? 1 : 0;
    $attr->{price_noformat} = $p;
    $attr->{absolute} = currency(abs($p), undef, 1);
    $attr->{price} = $extra = currency($p, undef, 1);
    $extra = " ($extra)";
  }

  my $vvalue = $value;
  encode($vvalue, $ESCAPE_CHARS::std);
  $run .= qq| value="$vvalue"|;
  $run .= qq| title="$help"| if $help;
  if (length($default)) {
    $regex  = qr/$re_b\Q$value\E$re_e/;
    $default =~ $regex and $select = 1;
  } elsif (defined($default) && length($value) == 0) {
    $select = 1;
  }
  $run .= ' SELECTED' if $select;
  $run .= '>';
  if($opt->{option_template}) {
    $attr->{label} = $label || $value;
    $attr->{value} = $value;
    $run .= attr_list($opt->{option_template}, $attr);
  }
  elsif($label) {
    $run .= $limit->($label);
    $run .= $extra;
  }
  else {
    $run .= $limit->($value);
    $run .= $extra;
  }
}
$run .= "</optgroup>" if $optgroup_one++;
$run .= attr_list($Template{selecttail}, $opt);
}

AUTHORS

Interchange Development Group

SEE ALSO

DocBook! Interchange!