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-unsubscr...@perl.apache.org
For additional commands, e-mail: embperl-cvs-h...@perl.apache.org

Reply via email to