Author: richter Date: Mon Mar 25 07:56:41 2013 New Revision: 1460537 URL: http://svn.apache.org/r1460537 Log: Support for disbleing single tabs & new file upload control (attachment)
Added: perl/embperl/trunk/Embperl/Form/Control/attachment.pm Modified: perl/embperl/trunk/Embperl/Form.pm perl/embperl/trunk/Embperl/Form/Control.pm perl/embperl/trunk/Embperl/Form/Control/tabs.pm Modified: perl/embperl/trunk/Embperl/Form.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form.pm?rev=1460537&r1=1460536&r2=1460537&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form.pm (original) +++ perl/embperl/trunk/Embperl/Form.pm Mon Mar 25 07:56:41 2013 @@ -67,7 +67,8 @@ sub sub_new $self -> {checkitems} = $options -> {checkitems} ; $self -> {valign} = $options -> {valign} || 'top' ; $self -> {jsnamespace} = $options -> {jsnamespace} || '' ; - $self -> {jsnamespace} .= '.' if ($self -> {jsnamespace}) ; + $self -> {jsnamespace} .= '.' if ($self -> {jsnamespace}) ; + $self -> {disable} = $options -> {disable} ; $self -> {control_packages} = $options -> {control_packages} ; $self -> {datasrc_packages} = $options -> {datasrc_packages} ; $self -> {formptr} = ($options -> {formptr} || "$self") . '/' . $id ; @@ -97,6 +98,7 @@ sub sub_new $self -> {prepare_fdat} = $self -> parent_form -> {prepare_fdat} ; $self -> {code_refs} = $self -> parent_form -> {code_refs} ; } + push @{$self -> {code_refs}}, $self if ($self -> has_code_refs) ; $self -> new_controls ($controls, $options, undef, $id, $validate_rules, $options -> {masks}, $options -> {defaults}) ; @@ -348,7 +350,8 @@ sub new_controls $ctlid = $control->{name} . '_' . $q ; $q++ ; } - my $class = ref $self ; + my $class = ref $self ; + local $options -> {disable} = $control -> {disables}[$i] ; my $subform = $class -> sub_new ($subcontrols, $options, $ctlid, $validate_rules, $self -> {formptr}) ; push @ids, $ctlid ; push @obj, $subform ; @@ -531,8 +534,10 @@ sub show_controls my @obj ; $control -> show_sub_begin ($req) ; foreach my $subobj (@{$control -> {subobjects}}) - { - next if (!$subobj || !$subobj -> {controls} || !@{$subobj -> {controls}}) ; + { +::dbg( $subobj -> is_disabled ($req) ) ; + next if (!$subobj || !$subobj -> {controls} || !@{$subobj -> {controls}} || $subobj -> is_disabled ($req)) ; +::dbg('show') ; $subobj -> show ($req, $activesubid[$control -> {level}]) ; } $control -> show_sub_end ($req) ; @@ -602,16 +607,62 @@ sub prepare_fdat { $control -> prepare_fdat ($req) ; } - } + } + +# --------------------------------------------------------------------------- +# +# is_disabled - do not display this control at all +# + +sub is_disabled + + { + my ($self, $req) = @_ ; + + my $disable = $self -> {disable} ; +::dbg($disable) ; + $disable = &{$disable}($self, $req) if (ref ($disable) eq 'CODE') ; +::dbg($disable) ; + return $disable ; + } + + +# --------------------------------------------------------------------------- +# +# has_code_refs - returns true if is_readonly or is_disabled are coderefs +# + +sub has_code_refs + + { + my ($self, $req) = @_ ; + + return ref ($self -> {disable}) eq 'CODE' ; + } + + +# --------------------------------------------------------------------------- +# +# code_ref_fingerprint - returns fingerprint of is_disabled +# + +sub code_ref_fingerprint + + { + my ($self, $req) = @_ ; + + return ($self -> is_disabled($req)?'D':'E') ; + } + # --------------------------------------------------------------------------- # -# code_ref_fingerprint - returns a fingerprint of the result of all code refs +# all_code_ref_fingerprints - returns a fingerprint of the result of all code refs # can be used to check if is_readonly or is_disabled # has dynamicly changed # -sub code_ref_fingerprint +sub all_code_ref_fingerprints { my ($self, $req) = @_ ; Modified: perl/embperl/trunk/Embperl/Form/Control.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control.pm?rev=1460537&r1=1460536&r2=1460537&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Control.pm (original) +++ perl/embperl/trunk/Embperl/Form/Control.pm Mon Mar 25 07:56:41 2013 @@ -146,7 +146,7 @@ sub code_ref_fingerprint { my ($self, $req) = @_ ; - return $self -> is_readonly?'R':'W' . $self -> is_disabled?'D':'E' ; + return ($self -> is_readonly($req)?'R':'W') . ($self -> is_disabled($req)?'D':'E') ; } Added: perl/embperl/trunk/Embperl/Form/Control/attachment.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/attachment.pm?rev=1460537&view=auto ============================================================================== --- perl/embperl/trunk/Embperl/Form/Control/attachment.pm (added) +++ perl/embperl/trunk/Embperl/Form/Control/attachment.pm Mon Mar 25 07:56:41 2013 @@ -0,0 +1,55 @@ + +################################################################################### +# +# Embperl - Copyright (c) 1997-2008 Gerald Richter / ecos gmbh www.ecos.de +# Embperl - Copyright (c) 2008-2012 Gerald Richter +# +# You may distribute under the terms of either the GNU General Public +# License or the Artistic License, as specified in the Perl README file. +# +# THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR +# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED +# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. +# +# $Id$ +# +################################################################################### + +package Embperl::Form::Control::attachment ; + +use base 'Embperl::Form::Control' ; +no warnings "uninitialized" ; + + +use strict ; + + +use Embperl::Inline ; + + +1 ; + +__EMBPERL__ + + +[# --------------------------------------------------------------------------- +# +# show_control - output the control +#] + +[$ sub show_control ($self) + +my $name = $self->{name}; +my $form = $self -> form ; +my $showoptions = $self -> {showoptions} ; +my $state = $self -> {state} ; + +$] +<div class="[+ $state +]" [+ do { local $escmode = 0 ; $self -> get_std_control_attr($req) } +] _ef_attach="ef_attachment" _ef_dynid="<_id>" _ef_attr="[+ $name +]"> + <a class="ef-attachment-download" href="#">Download</a> + <a class="ef-attachment-upload" href="#">Upload</a> + <a class="ef-attachment-delete" href="#">Löschen</a> + <input type="file" multiple style="display: none"> + <span class="ef-attachment-info"></span> +</div> +__END__ Modified: perl/embperl/trunk/Embperl/Form/Control/tabs.pm URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/tabs.pm?rev=1460537&r1=1460536&r2=1460537&view=diff ============================================================================== --- perl/embperl/trunk/Embperl/Form/Control/tabs.pm (original) +++ perl/embperl/trunk/Embperl/Form/Control/tabs.pm Mon Mar 25 07:56:41 2013 @@ -114,6 +114,7 @@ __EMBPERL__ my $val ; my $i = 0 ; + my $j = 0 ; my $more = 1 ; my $start_i = 0 ; my $line = 0 ; @@ -126,10 +127,15 @@ $] $more = 0 ; my $tabs = $tabs_per_line -> [$line++] ; *] - [$ while ($i < @$values) $] + [$ while ($j < @$values) $] [* - $val = $values -> [$i] ; - my $id = $self -> {subids}[$i] ; + if ($self -> {subobjects}[ $j ] -> is_disabled ($req)) + { + $j++ ; + next ; + } + $val = $values -> [$j] ; + my $id = $self -> {subids}[$j] ; my $cellclass = $id eq $activeid?'ef-tabs-cell-on':'ef-tabs-cell-off' ; my $divclass = $id eq $activeid?'ef-tabs-div-on':'ef-tabs-div-off' ; @@ -144,10 +150,11 @@ $] *] <td class="[+ $cellclass +]"><div class="ef-tabs-div [+ $divclass +]" [$ if $i - $start_i == 0 $]style="border-left: black 1px solid" [$endif$] - >[+ $options ->[$i] || $val +] + >[+ $options ->[$j] || $val +] </div></td> [* $i++ ; - if ($i - $start_i >= $tabs && @$values > $i) + $j++ ; + if ($i - $start_i >= $tabs && @$values > $j) { $more = 1 ; $start_i = $i ; @@ -155,7 +162,7 @@ $] } *] [$endwhile $] - [$if ($i == @$values) $]<td class="ef-tabs-cell-blank"> </td>[$endif$] + [$if ($j == @$values) $]<td class="ef-tabs-cell-blank"> </td>[$endif$] </tr></table> [$endwhile$] [#<input type="hidden" name="[+ $name +]" id="[+ $fullname +]" class="ef-field-tab_select" value="[+ $uid +]_[+ $activeid +]">#] --------------------------------------------------------------------- To unsubscribe, e-mail: embperl-cvs-unsubscr...@perl.apache.org For additional commands, e-mail: embperl-cvs-h...@perl.apache.org