Input.pm

NAME

Communiware::DE::Input - Dynamic element Input

SYNOPSIS

   <form>
   <:Input type name default ...:>
   ...
   </form>

DESCRIPTION

Implements form input elements on Communiware pages.

Dynamic element Input differs from the HTML INPUT tag, used in Communiware template, following ways:

  1. Default value is placed into Communiware request context.

  2. When form is submitted, user-supplied value is shown instead of default one.

  3. Template designer can generate popup-menus, scrolling lists and lists of radio buttons/checkboxes using Communiware filters.

  4. One dynamic element Input can produce a lot of radiobuttons or checkboxes.

  5. User supplied values can be stored as in the user cookies

  6. Date values can be reformatted upon submit.

  7. If input appears within multi-item posting, names are mangled to make attributes of different names distinct

Parameters of Input element:

type
Defines type of input element. Any value allowed for type attribute of the HTML tag INPUT except image.file and password is allowed. Additionaly, popupmenu, radiogroup and textarea can be used. Input type image can be directly coded into HTML.

name
Name of context attribute which would be changed by this dynamic element.

default
Value, which this input element has before yser changes it. For submit and reset this arg contain text, which would be displayed on the button.

type-specific parameters
Rest of parameters, with possible exception of last one, are type-specific. See description of input types for details

additional tag attributes
Last paremeter of Input dynamic element is comma-separated list of name=value pairs, which would be comverted into additional attributes of HTML tag. Typically useful for setting class of element.

INPUT ELEMENT TYPES

text
Additiional argument - size of entry field

date
Special form of text field - allows to enter date in desired format. First additional argument is date format which is strftime format string with only %d %m %y %Y %H %M and %S specificators allowed.

This additional parameter is required.

Second additional parmeter is field size.

textarea
Additional arguments number of lines and number of columns

checkbox
Individual checkbox. Generates either empty attribute or attribute with given default value. Rest of arguments, except last one if it is list of name=value pairs, is interpreted as logical expression, which indicates whether checkbox should be checked.

Name=value pairs in the last argument are added to the generated <input> tag as additional attributes. Attribute disabled is treated specially - when in HTML disabled would disable checkbox regardless of its value, in Communiware disabled=0 or empty string value means that checkbox should be enabled.

radio
Individual radiobutton. Almost useless unless you generate them by list. Arguments are exactly same as in standalone checkbox

radiogroup
Group of radiobuttons. Allows to choose one of them. There are two ways to specify list of values and there labels: using filter to select them from database or using inline list, specified directly in the template. For filter-based approach you need following additional parameters:
  1. Specification of the filter

  2. Name of the field, returned by the filter, which contain value

  3. Name of the field, containing label

  4. Label for the default value. Used if default value is not among those, returned by filter

For inline approach:

  1. word inline specified literally

  2. pairs of value name, as many as you need, in the order they would appear in the user browser. Each name and each value should be separate parameter. You should specify default value and its label along others.

Among other tag attributes attribute columns can be used for radiogroup. It specifies how many columns of radiobuttons would be produced.

popupmenu
Roughly same as radiogroup but uses less space of the page.

scrollinglist
Roughly same as popupmenu, but allows multiple choice.

checkboxgroup
Same as radiogroup, but allows multiple choice

submit

Submit button. Optionally causes some of user-changable attributes be stored in cookies.

Additional parameters:

  1. List of comma-separated attribute=value pairs which would be translated into additional attributes of input tag. Attribute confirm=message would produce javascript popup window, which asks user if he really want to submit this form. NOTE! This option produces onClick action and therefore it is incompatible with any other explicit onClick action.

  2. list of comma separated attribute names. If supplied, these attributes would be stored as user cookies. In posting context, only attributes which exists in posting context may be listed.

  3. Flag indicating domain of cookies. Possible values - server - current Communiware virtual server, item - current item and exact - exactly same URL as used in current request (without QUERY_STRING, of course), site - entire site (all virtual server as well as script directory. Use this only for creating your own customization forms, intended to replace default userprefs script.

reset
Reset button.

hidden
Produces hidden field. If appears in the posting context, prepends correct prefix to the field name

exec

  Communiware::DE::Input::exec($ctx,$type,@params)

Handles Input dynamic elements whose types are not known run_time 


=cut

sub exec { my $ctx = shift; my $type = shift; no strict 'refs'; return $types{$type}->($ctx, @_) if exists $types{$type}; return ``<span class=formError>No such Input type $type</span>''; }

sub compile { my $frag = shift; my ($type, undef, $is_const) = $frag->param(shift); my $name = $frag->param(shift); my $options = $frag->param_list(pop @_) if $_[-1] && $_[-1] =~ /^\w+=/; push @_, '' if !@_; $options ||= '{}'; if (!$is_const) { return $frag->make_exec($type, $name, map(scalar $frag->param($_), @_), $options); } else { $type = eval($type); $frag->compile_error(``Unknown input type '%s''', $type) unless exists $types{$type}; my $proc = $types{$type}; $proc = ``Communiware::DE::Input::$proc'' unless $proc =~ /::/; if ($type eq 'checkbox' || $type eq 'radio') { my $value = $frag->param(shift); my @expr = @_; @expr = ('0') unless @expr; my $expr_code = $frag->compile_expr(\@expr); $frag->compile_error(``Input %s: Extra args after expression'', $type) if @expr; return ``\$out .= $proc(\$ctx,$name,$value,$expr_code,$options);\n''; } else { if ($type eq 'submit') { my $value = shift; $options = $frag->param_list(shift) if @_; unshift @_, $value; } if ( grep {/^(popupmenu|checkboxgroup|radiogroup|scrollinglist)$/} $type ) { my $filter = $_[1]; $frag->uses_filter($filter) if $filter ne 'inline'; } return ``\$out .= $proc(\$ctx,$name,'' . join(',', map(scalar($frag->param($_)), @_), $options) . ``);\n''; } } }

sub hiddenfield { return hidden_field($_[0]->prefix . $_[1], $_[2]); }

sub text_input {
my $ctx = shift;
my $name = shift;
my $default = shift;
my $opts = pop || {};
my $size = shift;
my %args = (%$opts, name => (defined $ctx->prefix ? $ctx->prefix . $name : $name), value => $default);
        if (defined $size && length $size && $size !~ /^\d+$/) {
                die(sprintf("Parameter size for Input text must be number not '%s'", $size));
        }
        $args{'size'} = $size;
        delete $args{size} if !$args{size};
        my $fctx = $ctx->special_context('form');
        if ($fctx && defined $fctx->get($name)) {
                $args{value} = $fctx->get($name);
        }
    delete $args{value} unless defined $args{value} && length $args{value};
        $args{'type'} = 'text';
        return tag('input', \%args);
}

sub date_input {
my $ctx = shift;
my $name = shift;
my $inp_name = (defined $ctx->prefix ? $ctx->prefix . $name : $name);
my $default = shift;
my $opts = pop || {};
my $format = shift;
my $size = shift;
        $opts->{'name'} = "$inp_name.FMT";
        $opts->{'type'} = 'text';
        $opts->{'size'} = $size if $size;
        # replace for default value - get value from global context or if it
        # doesn't exsists get get current value
        if (defined(my $fctx = $ctx->special_context('form'))) {
                # value from global context must'n be formated
                if (!defined($opts->{'value'} = $ctx->special_context('global')->get($opts->{'name'}))) {
                        # get current value by standart way
                        $default = $fctx->get($name) if defined $fctx->get($name);
                }
        }
        $opts->{'value'} = Communiware::Date::format_date($default, $format)
          unless defined $opts->{'value'};
        return hidden_field("$inp_name.PKT", $format)
          . hidden_field("dates", $name)
          . tag('input', $opts);
}

sub textarea_input { my $ctx = shift; my $name = shift; my $default = shift; my $opts = pop; my $fctx = $ctx->special_context('form'); $default = $fctx->get($name) if $fctx && defined $fctx->get($name); my %args = (name => $ctx->prefix . $name, wrap => ``soft'', %$opts); my $rows = shift; $args{rows} = $rows if $rows; my $cols = shift; $args{cols} = $cols if $cols; return tag('textarea', \%args, escapeHTML($default)); }

sub checkbox_input {
my $ctx = shift;
my $name = shift;
my $value = shift;
my $opts = pop;
my %args = (type => 'checkbox', name => $ctx->prefix . $name, value => $value, %$opts);
        # cheking disabled
        ($args{onclick} = "return false;", $args{disabled} = 1) if delete $args{disabled};
        my $fctx = $ctx->special_context('form');
        $fctx->mark_checkbox($name) if $fctx;
        if ($fctx && defined $fctx->get($name)) {
                if (grep (/^\Q$value\E$/, $fctx->get($name))) {
                        $args{checked} = 'checked';
                }
                else {
                        delete $args{checked};
                }
        }
        else {
                $args{checked} = 'checked' if eval_button_condition(@_);
        }
        return tag('input', \%args);
}

sub eval_button_condition { return $_[0] if @_ == 1; if (@_) { my @expr = @_; my $code =Communiware::Expr->new(atomparser=>\&Communiware::Expr::quote)->compile_expr(\@expr); return 1 if eval($code); } return ''; } 


sub radio_input {
        my $ctx   = shift;
        my $name  = shift;
        my $value = shift;
        my $opts  = pop;
        my %args  = (name => $ctx->prefix . $name, value => $value, type => 'radio', %$opts);
        ($args{onclick} = "return false;", $args{disabled} = 1) if delete $args{disabled};
        my $fctx;
        if (($fctx = $ctx->special_context('form')) && defined $fctx->get($name)) {
                $args{checked} = 'checked' if $fctx->get($name) eq $value;
        }
        else {
                $args{checked} = 'checked' if eval_button_condition(@_);
        }
        return tag('input', \%args);
}

sub radio_group { my $ctx = shift; my $opts = pop || {}; my $name = shift; my ($choices, $name_attr, $value_attr, $default) = prepare_group_list($ctx, 'p', @_); if ( !$choices ) { return $ctx->get('DEBUG') ? html_error_out('Cannot get list of choices!') : ''; } my $columns = delete($opts->{columns}) || 2; my @inputs; my ($fctx) = $ctx->special_context('form'); $default = $fctx->get($name) if $fctx && defined $fctx->get($name); $default = $choices->[0]{$name_attr} unless length($default); my $tagname = $ctx->prefix() . $name; return make_table( $columns, map(tag( 'input', { type => 'radio', name => $tagname, 'value' => $_->{$name_attr}, ($default eq $_->{$name_attr} ? ('checked' => 'checked') : ()), %$opts } ) . $_->{$value_attr}, @$choices) );

}

sub make_table { my $columns = shift; my $out .= '<table>'; my $rows = int(($#_ + $columns) / $columns); for (my $i = 0 ; $i < @_ ; $i += $columns) { $out .= ``<tr>''; for (my $j = 0 ; $j < $columns ; $j++) { last if $i + $j >= @_; $out .= ``<td>'' . ($_[$i + $j] || ``&nbsp'') . ``</td>''; } $out .= ``</tr>''; } $out .= ``</table>''; return $out; } 


sub popupmenu {
        my $ctx  = shift;
        my $opts = pop;
        my $name = shift;
        my ($choices, $name_attr, $value_attr, $default) = prepare_group_list($ctx, 't', @_);
    if ( !$choices ) {
        return $ctx->get('DEBUG')
          ? html_error_out('Cannot get list of choices!')
          : '';
    }
        my $fctx;
        if (($fctx = $ctx->special_context('form')) && defined $fctx->get($name)) {
                $default = $fctx->get($name);
        }
        return popup_menu($ctx->prefix() . $name, $choices, $name_attr, $value_attr, $default, %$opts);
}

sub scrollinglist { my $ctx = shift; my $opts = pop; my $name = shift; my ($choices, $name_attr, $value_attr, $default) = prepare_group_list($ctx, 't', @_); if ( !$choices ) { return $ctx->get('DEBUG') ? html_error_out('Cannot get list of choices!') : ''; } my $fctx = $ctx->special_context('form'); if ($fctx && defined $fctx->get($name)) { $default = $fctx->get($name); } $opts->{name} = $ctx->prefix . $name; $opts->{size} = 3 unless $opts->{size}; delete $opts->{multiple} unless $opts->{multiple}; my %to_check = map {$_ => 1} split(/\s*,\s*/, $default); return tag( 'select', $opts, join( ``'', map (tag( 'option', { value => $_->{$name_attr}, ($to_check{ $_->{$name_attr} } ? (selected => 'selected') : ()) }, $_->{$value_attr} ), @$choices) ) ); }

sub checkbox_group { my $ctx = shift; my $opts = pop; my $name = shift; my ($choices, $name_attr, $value_attr, $default) = prepare_group_list($ctx, 'p', @_); if ( !$choices ) { return $ctx->get('DEBUG') ? html_error_out('Cannot get list of choices!') : ''; } my $columns = delete($opts->{columns}) || 2; my $fctx = $ctx->special_context('form'); if ($fctx && defined $fctx->get($name)) { $default = $fctx->get($name); } $default = '' if !defined $default; $fctx->mark_checkbox($name) if $fctx; $opts->{name} = $ctx->prefix . $name; delete $opts->{multiple} unless $opts->{multiple}; my %to_check = map {$_ => 1} split(/\s*,\s*/, $default); return make_table( $columns, map(tag( 'input', { %$opts, type => 'checkbox', value => $_->{$name_attr}, ($to_check{ $_->{$name_attr} } ? (checked => 'checked') : ()) } ) . $_->{$value_attr}, @$choices) ); }

sub prepare_group_list { my $ctx = shift; my $format = shift; my $default = shift; my $filter = shift; my ($name_attr, $value_attr); my $choices = []; if ($filter eq 'inline') { while (@_) { push @$choices, { 'ITEM_ID' => shift, 'TITLE' => shift }; } $name_attr = 'ITEM_ID'; $value_attr = 'TITLE'; } else { $name_attr = shift; $value_attr = shift; my $default_label = shift; my $sort = shift;

        $default_label = defined $default_label ? $default_label: '';
        my @sort;
                @sort = split(/\s*,\s*/, $sort) if defined $sort;
        my ($sth, $type_info);
        eval {
            ($sth, $type_info) = $ctx->prepare_filter($filter, $name_attr, $value_attr, @sort);
        };
        if ($@) {
            # FIXME: catch only DB errors - rethrow other!
            die $@ if !ref $@;
            $ctx->logger->error($@);
            return (undef, undef, undef, undef);
        }
                $choices = $sth->fetchall_arrayref({});
                unless ($choices->[0]{$value_attr}) {
                        for (@$choices) {
                                $_->{$value_attr} = Communiware::Context::Item->new(attr => $_)->evaluate($value_attr);
                        }
                }
                if (($type_info->{$value_attr}[0] || '') eq 'RICHTEXT') {
                        $_->{$value_attr} = untag_html($_->{$value_attr}, $format) foreach @$choices;
                }
        if (defined $default && !length $default && !length $default_label) {
            $default = undef;
        }
                unshift @$choices, { $name_attr => $default, $value_attr => $default_label }
                  if length($default_label) && !grep(($default eq $_->{$name_attr}), @$choices);
        }
        return ($choices, $name_attr, $value_attr, $default);
}

sub submit_button {
my $ctx = shift;
my $name = shift;
my $default = shift;
my $opts = pop || {};
my %args = (%$opts, type => 'submit', name => $ctx->prefix . $name, value => $default);
if ($args{'confirm'}) {
$args{onclick} = ``return confirm('$args{confirm}')'';
}
delete $args{'confirm'};
my $out = '';
if (scalar(@_)) {
if ($ctx->prefix) {
                        # Form type=special or Post
                        $out = post_cookie($ctx, @_);
                }
                else {
                        # Form type=context
                        my $fctx = $ctx->special_context('form');
                        if ($fctx && $fctx->get($name)) {
                                #Form is already sumbitted. We have to set cookies
                                set_cookies($ctx, @_);
                        }
                }
        }
        return tag('input', \%args) . $out;
}
     
sub reset_button {
        my $ctx   = shift;
        my $name  = shift;
        my $value = shift;
        my $opts  = pop;
        return tag('input', { type => 'reset', 'value' => $value, %$opts });
}

# # Если третий параметр не пуст, запихивает в список, ссылка на который # передана первым параметром, пару второй => третий #

sub post_cookie { my $ctx = shift; my @fields = split(``,'', shift); my $prefix = $ctx->prefix; my %cookies = map ({ $_ => /\./ ? ``\%$_'' : ``\%$prefix$_'' } @fields); my $path = cookie_domain($ctx, shift); my @cookies; while (my ($name, $expr) = each(%cookies)) { push @cookies, make_cookie( $ctx, $name, { -value => $expr, -expires => '+10y', -path => $path } ); } s/%25/%/g foreach @cookies; return join('', map(hidden_field($prefix . ``Set-Cookie'', $_), @cookies)); }

sub set_cookies { my $ctx = shift; my @fields = split(``,'', shift); my $path = cookie_domain($ctx, shift); for (@fields) { $ctx->document->add_header( 'Set-Cookie', make_cookie( $ctx, $_, { -path => $path, -value => $ctx->get($_), -expires => ``+10y'' } ) ); } }

# # Преобразовывает коммуниверную специйфкацию области действия куки # в путь, соответствующиий RFC 2616 #

sub cookie_domain { my $ctx = shift; my $domain = shift || 'site'; my $path; if ($domain eq 'site') { $path = $ctx->PREFIX('URL'); } elsif ($domain eq 'item') { $path = $ctx->PREFIX('URL') . ``/'' . $ctx->special_context('document_item')->id; } elsif ($domain eq 'exact') { $path = Apache->request->uri; } elsif ($domain eq 'server') { $path = '/'; } else { die(``[Invalid domain '$domain']''); return ``''; } return $path; }

# # Определяет, был ли атрибут, указанный в качестве параметра, # получен из куки, или из формы #

sub from_cookie { my $name = shift; my @found = grep {$name eq $_} @Communiware::CookieArgs; return scalar(@found); }

1;

16 октябрь 2007 13:44