Mailing List Archive

svn commit: r1460537 - in /perl/embperl/trunk/Embperl: Form.pm Form/Control.pm Form/Control/attachment.pm Form/Control/tabs.pm
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>&nbsp;
+ <a class="ef-attachment-upload" href="#">Upload</a>&nbsp;
+ <a class="ef-attachment-delete" href="#">L&ouml;schen</a>&nbsp;
+ <input type="file" multiple style="display: none">&nbsp;
+ <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">&nbsp;</td>[$endif$]
+ [$if ($j == @$values) $]<td class="ef-tabs-cell-blank">&nbsp;</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-unsubscribe@perl.apache.org
For additional commands, e-mail: embperl-cvs-help@perl.apache.org