You are viewing a plain text version of this content. The canonical link for it is here.
Posted to embperl-cvs@perl.apache.org by ri...@apache.org on 2006/05/30 08:49:56 UTC
svn commit: r410198 - in /perl/embperl/trunk: ./ Embperl/ Embperl/Form/
Embperl/Form/Control/ Embperl/Form/Validate/ xsbuilder/
Author: richter
Date: Mon May 29 23:49:55 2006
New Revision: 410198
URL: http://svn.apache.org/viewvc?rev=410198&view=rev
Log:
Form::Validate utf-8 messages
Modified:
perl/embperl/trunk/Changes.pod
perl/embperl/trunk/Embperl.pm
perl/embperl/trunk/Embperl/Form.pm
perl/embperl/trunk/Embperl/Form/Control.pm
perl/embperl/trunk/Embperl/Form/Control/number.pm
perl/embperl/trunk/Embperl/Form/Control/radio.pm
perl/embperl/trunk/Embperl/Form/Control/select.pm
perl/embperl/trunk/Embperl/Form/Control/tabs.pm
perl/embperl/trunk/Embperl/Form/Control/tinymce.pm
perl/embperl/trunk/Embperl/Form/Control/transparent.pm
perl/embperl/trunk/Embperl/Form/ControlMultValue.pm
perl/embperl/trunk/Embperl/Form/DataSource.pm
perl/embperl/trunk/Embperl/Form/Validate.pm
perl/embperl/trunk/Embperl/Form/Validate/Default.pm
perl/embperl/trunk/Embperl/Form/Validate/EMail.pm
perl/embperl/trunk/Embperl/Form/Validate/FQDN_IPAddr.pm
perl/embperl/trunk/Embperl/Form/Validate/IPAddr.pm
perl/embperl/trunk/Embperl/Form/Validate/IPAddr_Mask.pm
perl/embperl/trunk/Embperl/Form/Validate/Number.pm
perl/embperl/trunk/Embperl/Form/Validate/TimeHHMM.pm
perl/embperl/trunk/Embperl/Form/Validate/TimeHHMMSS.pm
perl/embperl/trunk/Embperl/Form/Validate/TimeValue.pm
perl/embperl/trunk/Makefile.PL
perl/embperl/trunk/xsbuilder/WrapXS.pm
Modified: perl/embperl/trunk/Changes.pod
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Changes.pod?rev=410198&r1=410197&r2=410198&view=diff
==============================================================================
--- perl/embperl/trunk/Changes.pod (original)
+++ perl/embperl/trunk/Changes.pod Mon May 29 23:49:55 2006
@@ -7,6 +7,7 @@
- Use _stat() instead of stat() on Win32 to work around the problem
that Perl redefines stat() in an incompatibel way.
Spotted by Randy Korbes.
+ - Added UTF-8 messages to Embperl::Form::Validate.
- Documented all options of embpexec.pl.
=head1 2.2.0 8. Apr. 2006
Modified: perl/embperl/trunk/Embperl.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl.pm?rev=410198&r1=410197&r2=410198&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl.pm (original)
+++ perl/embperl/trunk/Embperl.pm Mon May 29 23:49:55 2006
@@ -49,7 +49,7 @@
@ISA = qw(Exporter DynaLoader);
-$VERSION = '2.2.0' ;
+$VERSION = '2.2.1_dev1' ;
if ($modperl = $ENV{MOD_PERL})
Modified: perl/embperl/trunk/Embperl/Form.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form.pm?rev=410198&r1=410197&r2=410198&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form.pm (original)
+++ perl/embperl/trunk/Embperl/Form.pm Mon May 29 23:49:55 2006
@@ -42,26 +42,26 @@
sub new
{
- my ($class, $controls, $options, $id, $validate_rules, $parentid) = @_ ;
-
+ my ($class, $controls, $options, $id, $validate_rules, $parentptr) = @_ ;
+
my $toplevel = $validate_rules?0:1 ;
$id ||= 'topdiv' ;
- $options ||= {} ;
-
+ $options ||= {} ;
+
my $self = ref $class?$class:{} ;
-
+
$self -> {controls} = $controls ;
$self -> {id} = $id ;
- $self -> {parentid} = $parentid ;
+ $self -> {parentptr} = $parentptr ;
$self -> {formname} = $options -> {formname} || 'topform' ;
$self -> {bottom_code} = [] ;
$self -> {validate_rules} = [] ;
$self -> {toplevel} = $toplevel ;
- $self -> {valign} = $options -> {valign} || 'top' ;
+ $self -> {valign} = $options -> {valign} || 'top' ;
bless $self, $class if (!ref $class);
-
- $forms{$id} = $self ;
+
+ $Embperl::FormData::forms{"$self"} = $self ;
if (!$validate_rules)
{
$validate_rules = $self -> {validate_rules} = [] ;
@@ -72,16 +72,16 @@
$self -> {noframe} = 1 if ($controls && @$controls > 0 &&
$controls -> [0] -> noframe) ;
-
+
if ($toplevel)
{
my $epf = $self -> {validate} = Embperl::Form::Validate -> new ($validate_rules, $self -> {formname}) if ($self -> {validate_rules}) ;
$self -> add_code_at_bottom ($epf -> get_script_code) ;
}
-
+
return $self ;
}
-
+
# ---------------------------------------------------------------------------
#
# DESTROY
@@ -90,13 +90,13 @@
sub DESTROY
{
my ($self) = @_ ;
-
- delete $forms{$self->{id}} ;
+
+ delete $Embperl::FormData::forms{"$self"} ;
}
-
+
# ---------------------------------------------------------------------------
#
-# get_control_packages
+# get_control_packages
#
# returns an array ref with packges where to search for control classes
#
@@ -104,13 +104,13 @@
sub get_control_packages
{
my ($self) = @_ ;
-
+
return $self -> {control_packages} || ['Embperl::Form::Control'] ;
}
# ---------------------------------------------------------------------------
#
-# get_datasrc_packages
+# get_datasrc_packages
#
# returns an array ref with packges where to search for data source classes
#
@@ -118,7 +118,7 @@
sub get_datasrc_packages
{
my ($self) = @_ ;
-
+
return $self -> {datasrc_packages} || ['Embperl::Form::DataSource'] ;
}
@@ -138,18 +138,18 @@
{
my ($self, $packages, $name, $args) = @_ ;
-
+
my $ctlmod ;
my $obj ;
-
+
$args ||= {} ;
-
- if ($name =~ /::/)
+
+ if ($name =~ /::/)
{
if (!defined (&{"$name\:\:new"}))
{
eval "require $name" ;
- warn $@ if ($@) ;
+ warn $@ if ($@) ;
}
$obj = $name -> new ($args) ;
$ctlmod = $name ;
@@ -162,32 +162,32 @@
if ($mod -> can('new'))
{
$obj = $mod -> new ($args) ;
- $ctlmod = $mod ;
+ $ctlmod = $mod ;
last ;
}
}
if (!$ctlmod)
- {
+ {
foreach my $package (@$packages)
{
my $mod = "$package\:\:$name" ;
eval "require $mod" ;
- warn $@ if ($@) ;
+ warn $@ if ($@) ;
if ($mod -> can('new'))
{
$obj = $mod -> new ($args) ;
- $ctlmod = $mod ;
+ $ctlmod = $mod ;
last ;
}
}
- }
+ }
}
- die "No Module found for type = $name, searched: @$packages" if (!$ctlmod) ;
+ die "No Module found for type = $name, searched: @$packages" if (!$ctlmod || !$obj) ;
return $obj ;
}
-
-
+
+
# ---------------------------------------------------------------------------
#
# new_controls - transform elements to control objects
@@ -198,10 +198,10 @@
{
my ($self, $controls, $options, $id, $formid, $validate_rules, $masks, $defaults) = @_ ;
-
+
my $n = 0 ;
my $packages = $self -> get_control_packages ;
-
+
foreach my $control (@$controls)
{
die "control definition must be a hashref or an object, is '$control' " if (!ref $control || ref $control eq 'ARRAY');
@@ -211,7 +211,8 @@
$control -> {parentid} = $id if ($id) ;
$control -> {id} ||= "$control->{name}-$n" ;
$control -> {formid} = $formid ;
-
+ $control -> {formptr} = "$self" ;
+
my $type = $control -> {type} ;
my $default = $defaults -> {$name} || $defaults -> {"*$type"} || $defaults -> {'*'};
my $mask = $masks -> {$name} || $masks -> {"*$type"} || $masks -> {'*'};
@@ -219,16 +220,16 @@
{
foreach (keys %$mask)
{
- $control -> {$_} = $mask -> {$_} ;
+ $control -> {$_} = $mask -> {$_} ;
}
- }
+ }
if ($default)
{
foreach (keys %$default)
{
- $control -> {$_} = $default -> {$_} if (!exists $control -> {$_}) ;
+ $control -> {$_} = $default -> {$_} if (!exists $control -> {$_}) ;
}
- }
+ }
if (ref $control eq 'HASH')
@@ -255,15 +256,15 @@
my @obj ;
my @ids ;
my $i = 1 ;
-
+
foreach my $subcontrols (@{$control -> {subforms}})
{
next if (!$subcontrols) ;
my $id = "$control->{name}-$i" ;
my $class = ref $self ;
- my $subform = $class -> new ($subcontrols, $options, $id, $validate_rules, $self -> {id}) ;
+ my $subform = $class -> new ($subcontrols, $options, $id, $validate_rules, "$self") ;
push @ids, $id ;
- push @obj, $subform ;
+ push @obj, $subform ;
$i++ ;
}
$control -> {subobjects} = \@obj ;
@@ -282,10 +283,10 @@
{
my ($self) = @_ ;
- return $Embperl::Form::forms{$self -> {parentid}} ;
+ return $Embperl::FormData::forms{$self -> {parentptr}} ;
}
-
+
# ---------------------------------------------------------------------------
#
# add_code_at_bottom - add js code at the bottom of the page
@@ -295,11 +296,11 @@
{
my ($self, $code) = @_ ;
-
+
push @{$self->{bottom_code}}, $code ;
}
-
+
# ---------------------------------------------------------------------------
#
# layout - build the layout of the form
@@ -335,8 +336,8 @@
$num = 0 ;
}
push @$line, $control ;
- $control -> {width_percent} = $width ;
- $control -> {x_percent} = $x ;
+ $control -> {width_percent} = $width ;
+ $control -> {x_percent} = $x ;
$x += $width ;
$num++ ;
$max_num = $num if ($num > $max_num) ;
@@ -369,17 +370,17 @@
foreach my $subobj (@{$control -> {subobjects}})
{
next if (!$subobj) ;
- $subobj -> layout ;
+ $subobj -> layout ;
}
}
}
-
+
push @lines, $line if (@$line);
- $self -> {max_num} = $max_num ;
- return $self -> {layout} = \@lines ;
+ $self -> {max_num} = $max_num ;
+ return $self -> {layout} = \@lines ;
}
-
+
# ---------------------------------------------------------------------------
#
# show_controls - output the form control area
@@ -388,63 +389,63 @@
sub show_controls
{
- my ($self, $data, $activeid) = @_ ;
+ my ($self, $req, $activeid) = @_ ;
my $lines = $self -> {layout} ;
my %n ;
my $activesubid ;
-
- $self -> show_controls_begin ($activeid) ;
+
+ $self -> show_controls_begin ($req, $activeid) ;
my $lineno = 0 ;
foreach my $line (@$lines)
{
my $lineid = @$line && $line->[0]{parentid}?"$line->[0]{parentid}":'id' ;
$n{$lineid} ||= 10 ;
-
- $self -> show_line_begin ($lineno, "$lineid-$n{$lineid}", $activesubid);
+
+ $self -> show_line_begin ($req, $lineno, "$lineid-$n{$lineid}", $activesubid);
foreach my $control (@$line)
{
- my $newactivesubid = $control -> get_active_id ;
- $control -> show ($data);
+ my $newactivesubid = $control -> get_active_id ($req) ;
+ $control -> show ($req);
$activesubid = $newactivesubid if ($newactivesubid) ;
if ($control -> {subobjects})
{
my @obj ;
- $control -> show_sub_begin ;
+ $control -> show_sub_begin ($req) ;
foreach my $subobj (@{$control -> {subobjects}})
{
next if (!$subobj || !$subobj -> {controls} || !@{$subobj -> {controls}}) ;
- $subobj -> show ($data, $activesubid) ;
+ $subobj -> show ($req, $activesubid) ;
}
- $control -> show_sub_end ;
+ $control -> show_sub_end ($req) ;
}
}
- $self -> show_line_end ($lineno);
+ $self -> show_line_end ($req, $lineno);
$lineno++ ;
$n{$lineid}++ ;
}
- $self -> show_controls_end ;
-
+ $self -> show_controls_end ($req) ;
+
return ;
}
# ---------------------------------------------------------------------------
#
-# show - output the form
+# show - output the form
#
sub show
{
- my ($self, $data, $activeid) = @_ ;
+ my ($self, $req, $activeid) = @_ ;
- $self -> show_form_begin if ($self -> {toplevel});
- $self -> show_controls ($data, $activeid) ;
- $self -> show_form_end if ($self -> {toplevel});
+ $self -> show_form_begin ($req) if ($self -> {toplevel});
+ $self -> show_controls ($req, $activeid) ;
+ $self -> show_form_end ($req) if ($self -> {toplevel});
}
-
-
+
+
# ---------------------------------------------------------------------------
#
# validate - validate the form input
@@ -453,7 +454,7 @@
sub validate
{
-
+
}
@@ -463,7 +464,7 @@
#
# fügt ein tab elsement mit subforms zu einem Formular hinzu
#
-# in $subform array mit hashs
+# in $subform array mit hashs
# text => <anzeige text>
# fn => Dateiname
# fields => Felddefinitionen (alternativ zu fn)
@@ -478,31 +479,31 @@
my @options ;
my @grids;
$args ||= {} ;
-
+
foreach my $file (@$subforms)
{
my $fn = $file -> {fn} ;
- my $subfields = $file -> {fields} ;
-
- push @options, $file -> {text};
+ my $subfields = $file -> {fields} ;
+
+ push @options, $file -> {text};
if ($fn)
{
- my $obj = Execute ({object => "./$fn"} ) ;
+ my $obj = Execute ({object => "./$fn"} ) ;
#$subfields = eval {$obj -> fields ($r, {%$file, %$args}) || undef};
}
push @forms, $subfields;
- push @grids, $file -> {grid};
+ push @grids, $file -> {grid};
push @values, $file -> {value} ||= scalar(@forms);
}
- return {
- section => 'cSectionText',
- name => '__auswahl',
- type => 'tabs',
- values => \@values,
+ return {
+ section => 'cSectionText',
+ name => '__auswahl',
+ type => 'tabs',
+ values => \@values,
grids => \@grids,
- options => \@options,
- subforms=> \@forms,
+ options => \@options,
+ subforms=> \@forms,
width => 1,
},
}
@@ -520,7 +521,7 @@
{
my ($self, $controls, $cnt) = @_ ;
- $cnt ||= @$controls ;
+ $cnt ||= @$controls ;
foreach my $control (@$controls)
{
$control -> {width} = $cnt ;
@@ -535,7 +536,7 @@
#
# fügt ein tab elsement mit subforms zu einem Formular hinzu
#
-# in $subform array mit hashs
+# in $subform array mit hashs
# text => <anzeige text>
# fn => Dateiname
# fields => Felddefinitionen (alternativ zu fn)
@@ -544,46 +545,46 @@
sub add_sublines
{
- my ($self, $object_data, $subforms, $type) = @_;
+ my ($self, $object_data, $subforms, $type) = @_;
my $name = $object_data->{name};
my $text = $object_data->{text};
my $width = $object_data->{width};
my $section = $object_data->{section};
-
+
$text ||= $name;
my @forms ;
my @values ;
my @options ;
-
+
foreach my $file (@$subforms)
{
my $fn = $file -> {fn} ;
- my $subfields = $file -> {fields} ;
+ my $subfields = $file -> {fields} ;
if ($fn)
{
- my $obj = Execute ({object => "./$fn"} ) ;
+ my $obj = Execute ({object => "./$fn"} ) ;
#$subfields = eval {$obj -> fields ($r,$file) || undef};
- }
+ }
push @forms, $subfields || [];
push @values, $file->{value} || $file->{name};
push @options, $file -> {text} || $file->{value} || $file->{name};
}
- return { section => $section , width => $width, name => $name , text => $text, type => $type || 'select',
+ return { section => $section , width => $width, name => $name , text => $text, type => $type || 'select',
values => \@values, options => \@options, sublines => \@forms,
class => $object_data->{class}, controlclass => $object_data->{controlclass}};
-
+
}
-
+
#------------------------------------------------------------------------------------------
#
# fields_add_checkbox_subform
#
-# fügt ein checkbox Element mit Subforms hinzu
+# fügt ein checkbox Element mit Subforms hinzu
#
-# in $subform array mit hashs
+# in $subform array mit hashs
# text => <anzeige text>
# name => <name des Attributes>
# value => <Wert der checkbox>
@@ -602,16 +603,16 @@
my $width = $subform->{width};
my $section;
-
+
if(! $subform->{nosection})
{
$section = $subform->{section};
$section ||= 1;
- }
+ }
$name ||= "__$value";
$width ||= 1;
-
+
my $subfield;
my $fn;
if($subfield = $subform->{fields})
@@ -620,18 +621,18 @@
}
elsif($fn = $subform->{fn})
{
- my $obj = Execute ({object => "./$fn"} ) ;
+ my $obj = Execute ({object => "./$fn"} ) ;
#$subfield = [eval {$obj -> fields ($r, { %$file, %$args} ) || undef}];
}
- return {type => 'checkbox' , section => $section, width => $width, name => $name, text => $text, value => $value, sublines => $subfield}
-
+ return {type => 'checkbox' , section => $section, width => $width, name => $name, text => $text, value => $value, sublines => $subfield}
+
}
-
+
1;
-
+
__EMBPERL__
@@ -639,10 +640,10 @@
[# ---------------------------------------------------------------------------
#
-# show_form_begin - output begin of form
+# show_form_begin - output begin of form
#]
-[$ sub show_form_begin ($self) $]
+[$ sub show_form_begin ($self, $req) $]
<script language="javascript">var doValidate = 1 ;</script>
<script src="/js/EmbperlForm.js"></script>
<script src="/js/TableCtrl.js"></script>
@@ -661,16 +662,16 @@
# show_form_end - output end of form
#]
-[$ sub show_form_end $]
+[$ sub show_form_end ($req) $]
</form>
-[$endsub$]
+[$endsub$]
[ ---------------------------------------------------------------------------
#
# show_controls_begin - output begin of form controls area
#]
-[$ sub show_controls_begin ($self, $activeid)
+[$ sub show_controls_begin ($self, $req, $activeid)
my $parent = $self -> parent_form ;
my $class = $parent -> {noframe}?'cTableDivU':'cTableDiv' ;
@@ -681,54 +682,54 @@
[$if (!$self -> {noframe}) $]<table class="[+ $class +]"><tr><td class="cTabTD"> [$endif$]
<table class="cBase cTable">
[$endsub$]
-
+
[# ---------------------------------------------------------------------------
#
# show_controls_end - output end of form controls area
#]
-[$sub show_controls_end ($self) $]
+[$sub show_controls_end ($self, $req) $]
</table>
[$ if (!$self -> {noframe}) $]</td></tr></table> [$endif$]
</div>
-
+
[$ if (@{$self->{bottom_code}}) $]
<script language="javascript">
[+ do { local $escmode = 0; join ("\n", @{$self->{bottom_code}}) } +]
</script>
[$endif$]
[$endsub$]
-
+
[# ---------------------------------------------------------------------------
#
# show_line_begin - output begin of line
#]
-[$ sub show_line_begin ($self, $lineno, $id, $activeid)
-
+[$ sub show_line_begin ($self, $req, $lineno, $id, $activeid)
+
$id =~ /^(.+)-(\d+?)-(\d+?)$/ ;
my $baseid = $1 ;
my $baseidn = $2 ;
$activeid =~ /^(.+)-(\d+?)$/ ;
my $baseaid = $1 ;
my $baseaidn = $2 ;
-
+
my $class = $lineno == 0?'cTableRow1':'cTableRow' ;
-$]
+$]
<tr class="[+ $class +]" valign="[+ $self->{valign} +]"
[$if $id $] id="[+ $id +]"[$endif$]
[$if ($baseid eq $baseaid && $baseidn != $baseaidn) $] style="display: none"[$endif$]
>
[$endsub$]
-
+
[# ---------------------------------------------------------------------------
#
# show_line_end - output end of line
#]
-[$ sub show_line_end $]
+[$ sub show_line_end ($req) $]
</tr>
-[$endsub$]
+[$endsub$]
__END__
@@ -749,7 +750,7 @@
=over 4
-=item * $controls
+=item * $controls
Array ref with controls which should be displayed
inside the form. Each control needs either to be a
@@ -778,9 +779,9 @@
=item * masks
Contains a hash ref which can specify a set of masks
-for the controls. A mask is a set of parameter which
+for the controls. A mask is a set of parameter which
overwrite the setting of a control. You can specify
-a mask for a control name (key is name), for a control
+a mask for a control name (key is name), for a control
type (key is *type) or for all controls (key is *).
Example:
@@ -789,18 +790,18 @@
'info' => { readonly => 1},
'*textarea' => { cols => 80 },
'*' => { labelclass => 'myclass', labelnowrap => 1}
- }
-
+ }
+
This will force the control with the name C<info> to be readonly, it
will force all C<textarea> controls to have 80 columns and
it will force the label of all controls to have a class of myclass
-and not to wrap the text.
+and not to wrap the text.
=item * defaults
Contains a hash ref which can specify a set of defaults
for the controls. You can specify
-a default for a control name (key is name), for a control
+a default for a control name (key is name), for a control
type (key is *type) or for all controls (key is *).
Example:
@@ -809,12 +810,12 @@
'info' => { readonly => 1},
'*textarea' => { cols => 80 },
'*' => { labelclass => 'myclass', labelnowrap => 1}
- }
-
+ }
+
This will make the control with the name C<info> to default to be readonly, it
will deafult all C<textarea> controls to have 80 columns and
it will set the default class for the labels of all controls to
-myclass and not to wrap the text.
+myclass and not to wrap the text.
=item * valign
Modified: perl/embperl/trunk/Embperl/Form/Control.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control.pm?rev=410198&r1=410197&r2=410198&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control.pm Mon May 29 23:49:55 2006
@@ -31,12 +31,12 @@
{
my ($class, $args) = @_ ;
-
+
my $self = { %$args } ;
bless $self, $class ;
-
+
$self -> init ;
-
+
return $self ;
}
@@ -49,11 +49,11 @@
{
my ($self) = @_ ;
-
+
return $self ;
}
-
-
+
+
# ---------------------------------------------------------------------------
#
# noframe - do not draw frame border if this is the only control
@@ -73,8 +73,8 @@
sub is_disabled
{
- my ($self) = @_ ;
-
+ my ($self, $req) = @_ ;
+
return $self -> {disable} ;
}
@@ -86,8 +86,8 @@
sub is_readonly
{
- my ($self) = @_ ;
-
+ my ($self, $req) = @_ ;
+
return $self -> {readonly} ;
}
@@ -99,22 +99,22 @@
sub show
{
- my ($self, $data) = @_ ;
+ my ($self, $req) = @_ ;
$fdat{$self -> {name}} = $self -> {default} if ($fdat{$self -> {name}} eq '' && exists ($self -> {default})) ;
my $span = 0 ;
- $span += $self -> show_label_cell ($span);
- return $self -> show_control_cell ($span, $data) ;
+ $span += $self -> show_label_cell ($req, $span);
+ return $self -> show_control_cell ($req, $span) ;
}
-
+
# ---------------------------------------------------------------------------
#
-# get_on_show_code
+# get_on_show_code
#
# retuns js code that should be excuted when form becomes visible
#
-sub get_on_show_code
+sub get_on_show_code
{
return ;
}
@@ -139,22 +139,22 @@
{
my ($self) = @_ ;
- return $Embperl::Form::forms{$self -> {formid}} ;
+ return $Embperl::FormData::forms{$self -> {formptr}} ;
}
# ---------------------------------------------------------------------------
#
# get_validate_rules - get rules for validation
#
-
+
sub get_validate_rules
{
- my ($self) = @_ ;
+ my ($self, $req) = @_ ;
my @local_rules ;
if ($self -> {validate})
{
-
+
@local_rules = ( -key => $self->{name} );
push @local_rules, -name => $self->{text} if ($self -> {text}) ;
push @local_rules, @{$self -> {validate}};
@@ -170,25 +170,25 @@
__EMBPERL__
[$syntax EmbperlBlocks $]
-
+
[# ---------------------------------------------------------------------------
#
# show_sub_begin - output begin of sub form
#]
-[$sub show_sub_begin ($self)
-
+[$sub show_sub_begin ($self, $req)
+
my $span = $self->{width_percent} ;
$]
</tr><tr><td class="cBase cTabTD" colspan="[+ $span +]">
[$endsub$]
-
+
[# ---------------------------------------------------------------------------
#
# show_sub_end - output end of sub form
#]
-[$sub show_sub_end ($self) $]
+[$sub show_sub_end ($self, $req) $]
</td>
[$endsub$]
@@ -197,14 +197,14 @@
# show - output the label
#]
-[$ sub show_label ($self) $][+ $self->{text} || $self->{name} +][$endsub$]
+[$ sub show_label ($self, $req) $][+ $self->{text} || $self->{name} +][$endsub$]
[# ---------------------------------------------------------------------------
#
# show_label_icon - output the icon before the label
#]
-[$sub show_label_icon ($self) $]
+[$sub show_label_icon ($self, $req) $]
[$if $self -> {sublines} $] <img src="plus.png" style="vertical-align: middle;">[$endif$]
[$if $self -> {parentid} $] <img src="vline.png" style="vertical-align: middle;">[$endif$]
[$endsub$]
@@ -214,7 +214,7 @@
# show - output the control
#]
-[$ sub show_label_cell ($self)
+[$ sub show_label_cell ($self, $req)
my $style = "";
$style = "white-space:nowrap;" if ($self->{labelnowrap}) ;
@@ -223,8 +223,8 @@
<td class="cLabelBox[$ if $self->{labelclass} $][+ " $self->{labelclass}" +][$ endif $]"
colspan="1" [$ if $style $]style="[+ $style +]"[$ endif $]>
[-
- $self -> show_label ;
- $self -> show_label_icon ;
+ $self -> show_label ($req);
+ $self -> show_label_icon ($req) ;
-]
</td>
[- return 1; -]
@@ -235,14 +235,14 @@
# show_control - output the control itself
#]
-[$ sub show_control ($self) $][+ $self->{value} +][$endsub$]
+[$ sub show_control ($self, $req) $][+ $self->{value} +][$endsub$]
[# ---------------------------------------------------------------------------
#
# show_control_readonly - output the control as readonly
#]
-[$ sub show_control_readonly ($self) $][+ $self -> {value} || $fdat{$self -> {name}} +][$endsub$]
+[$ sub show_control_readonly ($self, $req) $][+ $self -> {value} || $fdat{$self -> {name}} +][$endsub$]
[# ---------------------------------------------------------------------------
@@ -250,12 +250,12 @@
# show_controll_cell - output the table cell for the control
#]
-[$ sub show_control_cell ($self, $x)
+[$ sub show_control_cell ($self, , $req, $x)
my $span = $self->{width_percent} - $x ;
$]
<td class="cControlBox" colspan="[+ $span +]">
- [* my @ret = $self -> is_readonly?$self -> show_control_readonly:$self -> show_control ; *]
+ [* my @ret = $self -> is_readonly?$self -> show_control_readonly($req):$self -> show_control ($req); *]
</td>
[* return @ret ; *]
[$endsub$]
@@ -305,7 +305,7 @@
Output the control
-=head2 get_on_show_code
+=head2 get_on_show_code
Returns JavaScript code that should be executed when the form becomes visible
@@ -356,7 +356,7 @@
Specifies the name of the control
-=head3 text
+=head3 text
Will be used as label for the control, if not given
name is used as default
Modified: perl/embperl/trunk/Embperl/Form/Control/number.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/number.pm?rev=410198&r1=410197&r2=410198&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/number.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/number.pm Mon May 29 23:49:55 2006
@@ -24,18 +24,19 @@
1 ;
__EMBPERL__
-
+
[# ---------------------------------------------------------------------------
#
# show_control - output the control
#]
-[$ sub show_control ($self)
+[$ sub show_control ($self)
- $self->{size} ||= 10 ;
-$]
+ $self->{size} ||= 10 ;
+ $self->{css_width} ||= '50%' ;
+$]
[- $self -> SUPER::show_control ; -]
-[$if ($self->{unit}) $][+ $self ->{unit} +][$endif$] ;
+[$if ($self->{unit}) $][+ $self ->{unit} +][$endif$]
[$endsub$]
__END__
@@ -49,9 +50,9 @@
=head1 SYNOPSIS
- {
+ {
type => 'input',
- text => 'blabla',
+ text => 'blabla',
name => 'foo',
unit => 'sec',
}
@@ -72,7 +73,7 @@
Specifies the name of the control
-=head3 text
+=head3 text
Will be used as label for the numeric input control
Modified: perl/embperl/trunk/Embperl/Form/Control/radio.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/radio.pm?rev=410198&r1=410197&r2=410198&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/radio.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/radio.pm Mon May 29 23:49:55 2006
@@ -27,26 +27,26 @@
# show_control_readonly - output readonly control
#
-sub show_control_readonly
+sub show_control_readonly
{
- my ($self) = @_ ;
-
+ my ($self, $req) = @_ ;
+
my $name = $self -> {name} ;
- $self -> show_control ("^\Q$fdat{$name}\\E\$") ;
+ $self -> show_control ($req, "^\Q$fdat{$name}\\E\$") ;
}
1 ;
__EMBPERL__
-
+
[# ---------------------------------------------------------------------------
#
# show_control - output the control
#]
-[$ sub show_control ($self, $filter)
+[$ sub show_control ($self, $req, $filter)
- my ($values, $options) = $self -> get_values ;
+ my ($values, $options) = $self -> get_values ($req) ;
my $name = $self -> {name} ;
$filter ||= $self -> {filter} ;
my $addtop = $self -> {addtop} || [] ;
@@ -54,7 +54,7 @@
my $max = @$values ;
my $set = !defined ($fdat{$name})?1:0 ;
- my $val ;
+ my $val ;
my $i = 0 ;
$]
[$ foreach $val (@$addtop) $]
@@ -97,9 +97,9 @@
=head1 SYNOPSIS
- {
+ {
type => 'radio',
- text => 'blabla',
+ text => 'blabla',
name => 'foo',
values => [1,2,3],
options => ['foo', 'bar', 'none'],
@@ -120,7 +120,7 @@
Specifies the name of the radio control
-=head3 text
+=head3 text
Will be used as label for the radio control
@@ -141,7 +141,7 @@
=head3 addtop
Array ref which contains items that should be added at the left or top
-of the radio buttons. Each item consists of an array ref with two
+of the radio buttons. Each item consists of an array ref with two
entries, the first is the value and the second is the option
that is displayed on the page. If the second is missing the
value (first entry)is displayed. Example:
@@ -151,7 +151,7 @@
=head3 addbottom
Array ref which contains items that should be added at the right or bottom
-of the radio buttons. Each item consists of an array ref with two
+of the radio buttons. Each item consists of an array ref with two
entries, the first is the value and the second is the option
that is displayed on the page. If the second is missing the
value (first entry)is displayed. Example:
@@ -160,7 +160,7 @@
=head3 filter
-If given, only items where the value matches the regex given in
+If given, only items where the value matches the regex given in
C<filter> are displayed.
=head1 Author
Modified: perl/embperl/trunk/Embperl/Form/Control/select.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/select.pm?rev=410198&r1=410197&r2=410198&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/select.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/select.pm Mon May 29 23:49:55 2006
@@ -27,12 +27,12 @@
# show_control_readonly - output readonly control
#
-sub show_control_readonly
+sub show_control_readonly
{
- my ($self) = @_ ;
-
+ my ($self, $req) = @_ ;
+
my $name = $self -> {name} ;
- $self -> show_control ("^\Q$fdat{$name}\\E\$") ;
+ $self -> show_control ($req, "^\Q$fdat{$name}\\E\$") ;
}
@@ -40,22 +40,22 @@
1 ;
__EMBPERL__
-
+
[# ---------------------------------------------------------------------------
#
# show_control - output the control
#]
-[$ sub show_control ($self)
+[$ sub show_control ($self, $req, $filter)
- my ($values, $options) = $self -> get_values ;
+ my ($values, $options) = $self -> get_values ($req) ;
my $name = $self -> {name} ;
- my $filter = $self -> {filter} ;
+ $filter ||= $self -> {filter} ;
my $addtop = $self -> {addtop} || [] ;
my $addbottom= $self -> {addbottom} || [] ;
- my $val ;
+ my $val ;
my $i = 0 ;
-$]
+$]
<select class="cBase cControl" name="[+ $name +]" id="[+ $name +]"
[$if ($self -> {sublines} || $self -> {subobjects}) $] OnChange="show_selected(this)" [$endif$]
[$if ($self -> {rows}) $] size="[+ $self->{rows} +]" [$endif$]
@@ -91,9 +91,9 @@
=head1 SYNOPSIS
- {
+ {
type => 'select',
- text => 'blabla',
+ text => 'blabla',
name => 'foo',
values => [1,2,3],
options => ['foo', 'bar', 'none'],
@@ -115,7 +115,7 @@
Specifies the name of the select control
-=head3 text
+=head3 text
Will be used as label for the select control
@@ -136,7 +136,7 @@
=head3 addtop
Array ref which contains items that should be added at the top
-of the select box. Each item consists of an array ref with two
+of the select box. Each item consists of an array ref with two
entries, the first is the value and the second is the option
that is displayed on the page. If the second is missing the
value (first entry)is displayed. Example:
@@ -146,7 +146,7 @@
=head3 addbottom
Array ref which contains items that should be added at the bottom
-of the select box. Each item consists of an array ref with two
+of the select box. Each item consists of an array ref with two
entries, the first is the value and the second is the option
that is displayed on the page. If the second is missing the
value (first entry)is displayed. Example:
@@ -155,7 +155,7 @@
=head3 filter
-If given, only items where the value matches the regex given in
+If given, only items where the value matches the regex given in
C<filter> are displayed.
Modified: perl/embperl/trunk/Embperl/Form/Control/tabs.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/tabs.pm?rev=410198&r1=410197&r2=410198&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/tabs.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/tabs.pm Mon May 29 23:49:55 2006
@@ -34,10 +34,10 @@
{
my ($class, $args) = @_ ;
-
+
my $self = Embperl::Form::ControlMultValue -> new($args) ;
bless $self, $class ;
-
+
$self -> {width} = 1 ;
return $self ;
}
@@ -62,9 +62,9 @@
sub get_active_id
{
- my ($self) = @_ ;
+ my ($self, $req) = @_ ;
- my ($values, $options) = $self -> get_values ;
+ my ($values, $options) = $self -> get_values ($req) ;
my $name = $self -> {name} ;
my $dataval = $fdat{$name} || $values -> [0] ;
my $activeid ;
@@ -87,23 +87,23 @@
1 ;
__EMBPERL__
-
+
[# ---------------------------------------------------------------------------
#
# show - output the control
#]
-[$ sub show ($self)
+[$ sub show ($self)
my ($values, $options) = $self -> get_values ;
my $span = ($self->{width_percent}) ;
my $name = $self -> {name} ;
my $dataval = $fdat{$name} || $values -> [0] ;
my $activeid = $self -> get_active_id ;
-
- my $val ;
+
+ my $val ;
my $i = 0 ;
-$]
+$]
<td class="cBase cTabTD" colspan="[+ $span +]">
<table class="cBase cTabTable" ><tr class="cBase cTabRow">
@@ -115,14 +115,14 @@
my $form = $self -> form ;
my @switch_code ;
-
+
foreach my $sub (@{$form -> {controls}})
{
my $code = $sub -> get_on_show_code ;
push @switch_code, $code if ($code) ;
}
- my $js = join (';', @switch_code) ;
- *]
+ my $js = join (';', @switch_code) ;
+ *]
<td class="cBase [+ $cellclass +]"><div class="cBase [+ $divclass +]" id="__tabs_[+ $id +]">
<a href="#" onClick="tab_selected('[+ $id +]','[+ $name +]'); [+ do { local $escmode = 0 ; $js } +]" style="color:black; text-decoration: none;">[+ $options ->[$i] || $val +]</a></div></td>
[* $i++ *]
@@ -144,7 +144,7 @@
=head1 SYNOPSIS
- Embperl::Form -> add_tabs (
+ Embperl::Form -> add_tabs (
[
{
text => 'First Tab',
@@ -152,7 +152,7 @@
...
]
},
- {
+ {
text => 'Second Tab',
fields => [
...
@@ -165,7 +165,7 @@
=head1 DESCRIPTION
Control to display tabs at the top of the form and control the switching between sub forms.
-The switching is done by Javascript, so it can only be used in environment where
+The switching is done by Javascript, so it can only be used in environment where
Javascript is available.
You can use the method Embperl::Form -> add_tabs
@@ -175,13 +175,13 @@
=head2 PARAMETER
-=head3 text
+=head3 text
Text that will be displayed on the tab
=head3 fields
-List of fields that should be displayed in this subform.
+List of fields that should be displayed in this subform.
Given in the same form as form Embperl::Form.
Modified: perl/embperl/trunk/Embperl/Form/Control/tinymce.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/tinymce.pm?rev=410198&r1=410197&r2=410198&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/tinymce.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/tinymce.pm Mon May 29 23:49:55 2006
@@ -24,7 +24,7 @@
1 ;
__EMBPERL__
-
+
[# ---------------------------------------------------------------------------
#
# show_control - output the control
@@ -33,6 +33,29 @@
[$ sub show_control ($self) $]
<script language="javascript" type="text/javascript" src="/tiny_mce/tiny_mce.js"></script>
+[$ if $self -> {theme} ne 'big' $]
+<script language="javascript" type="text/javascript">
+ tinyMCE.init({
+ mode : "textareas",
+ theme : "advanced",
+ plugins : "table,insertdatetime,searchreplace,print,contextmenu,paste,fullscreen,noneditable",
+ theme_advanced_buttons1 : "bold,italic,underline,strikethrough,bullist,numlist,outdent,indent,undo,redo,link,unlink,image,code,hr,sub,sup,forecolor,backcolor,charmap,table",
+ theme_advanced_buttons2 : "",
+ theme_advanced_buttons3 : "",
+ theme_advanced_toolbar_location : "top",
+ theme_advanced_toolbar_align : "left",
+ theme_advanced_path_location : "bottom",
+ content_css : "example_full.css",
+ plugin_insertdate_dateFormat : "%d.%m.%Y",
+ plugin_insertdate_timeFormat : "%H:%M:%S",
+ extended_valid_elements : "hr[class|width|size|noshade],font[face|size|color|style],span[class|align|style]",
+ xtheme_advanced_resize_horizontal : false,
+ theme_advanced_resizing : true,
+ editor_selector : "cBase cControl cMceEditor",
+ width: "100%"
+ });
+</script>
+[$else$]
<script language="javascript" type="text/javascript">
tinyMCE.init({
mode : "textareas",
@@ -54,6 +77,7 @@
width: "100%"
});
</script>
+[$endif$]
<textarea type="text" class="cBase cControl cMceEditor" name="[+ $self->{name} +]"
[$if $self -> {cols} $]cols="[+ $self->{cols} +]"[$endif$]
@@ -72,9 +96,9 @@
=head1 SYNOPSIS
- {
+ {
type => 'tinymce',
- text => 'blabla',
+ text => 'blabla',
name => 'foo',
rows => 10,
cols => 80,
@@ -91,7 +115,7 @@
Needs to be 'tinymce'
-=head3 text
+=head3 text
Will be used as label for the text input control
Modified: perl/embperl/trunk/Embperl/Form/Control/transparent.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/transparent.pm?rev=410198&r1=410197&r2=410198&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/transparent.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Control/transparent.pm Mon May 29 23:49:55 2006
@@ -24,13 +24,13 @@
1 ;
__EMBPERL__
-
+
[# ---------------------------------------------------------------------------
#
# show - output the control
#]
-[$ sub show ($self, $data)
+[$ sub show ($self, $req)
my $span = ($self->{width_percent}) ;
$]
@@ -49,9 +49,9 @@
=head1 SYNOPSIS
- {
+ {
type => 'transparent',
- text => 'blabla'
+ text => 'blabla'
}
=head1 DESCRIPTION
Modified: perl/embperl/trunk/Embperl/Form/ControlMultValue.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/ControlMultValue.pm?rev=410198&r1=410197&r2=410198&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/ControlMultValue.pm (original)
+++ perl/embperl/trunk/Embperl/Form/ControlMultValue.pm Mon May 29 23:49:55 2006
@@ -1,151 +1,150 @@
-
-###################################################################################
-#
-# Embperl - Copyright (c) 1997-2005 Gerald Richter / ecos gmbh www.ecos.de
-#
-# 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::ControlMultValue ;
-
-use strict ;
-use vars qw{%fdat} ;
-
-use base 'Embperl::Form::Control' ;
-
-# ---------------------------------------------------------------------------
-#
-# init - Init the new control
-#
-
-
-sub init
-
- {
- my ($self) = @_ ;
-
- if ($self -> {datasrc})
- {
- my $form = $self -> form ;
- my $packages = $form -> get_datasrc_packages ;
- my $self -> {datasrcobj} = $form -> new_object ($packages, $self -> {datasrc}, $self) ;
- }
-
- return $self ;
- }
-
-
-# ---------------------------------------------------------------------------
-#
-# get_values - returns the values and options
-#
-
-sub get_values
-
- {
- my ($self) = @_ ;
-
- return $self -> {datasrcobj} -> get_values if ($self -> {datasrcobj}) ;
- return ($self -> {values}, $self -> {options}) ;
- }
-
-
-# ---------------------------------------------------------------------------
-#
-# get_active_id - get the id of the value which is currently active
-#
-
-sub get_active_id
-
- {
- my ($self) = @_ ;
-
- my ($values, $options) = $self -> get_values ;
- my $name = $self -> {name} ;
- my $dataval = $fdat{$name} || $values -> [0] ;
- my $activeid ;
-
- my $i = 0 ;
- foreach my $val (@$values)
- {
- if ($val eq $dataval)
- {
- $activeid = "$name-$i" ;
- last ;
- }
- $i++ ;
- }
-
- return $activeid ;
- }
-
-
-1 ;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-Embperl::Form::ControlMultValue - Base class for controls inside
-an Embperl Form which have multiple values to select from, like
-a select box or radio buttons.
-
-
-=head1 SYNOPSIS
-
-Do not use directly, instead derive a class
-
-=head1 DESCRIPTION
-
-This class is not used directly, it is used as a base class for
-all controls which have multiple values to select from inside
-an Embperl Form. It provides a set of methods
-that could be overwritten to customize the behaviour of your controls.
-
-=head1 METHODS
-
-=head2 get_values
-
-returns the values and options
-
-=head2 get_active_id
-
-get the id of the value which is currently active
-
-=head1 PARAMETERS
-
-=head3 values
-
-Arrayref with the values to select from. This is what gets
-submited back to the server.
-
-=head3 options
-
-Arrayref with the options to select from. This is what the user sees.
-
-=head3 datasrc
-
-Name of an class which provides the values for the
-values and options parameters. Either a full package name or
-a name, in which case all packages which are returned
-by Embperl::Form::get_datasrc_packages are searched.
-
-=head1 AUTHOR
-
-G. Richter (richter@dev.ecos.de)
-
-=head1 SEE ALSO
-
-perl(1), Embperl, Embperl::Form, Embperl::From::Control, Embperl::Form::DataSource
-
-
\ No newline at end of file
+
+###################################################################################
+#
+# Embperl - Copyright (c) 1997-2005 Gerald Richter / ecos gmbh www.ecos.de
+#
+# 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::ControlMultValue ;
+
+use strict ;
+use vars qw{%fdat} ;
+
+use base 'Embperl::Form::Control' ;
+
+# ---------------------------------------------------------------------------
+#
+# init - Init the new control
+#
+
+
+sub init
+
+ {
+ my ($self) = @_ ;
+
+ if ($self -> {datasrc})
+ {
+ my $form = $self -> form ;
+ my $packages = $form -> get_datasrc_packages ;
+ $self -> {datasrcobj} = $form -> new_object ($packages, $self -> {datasrc}, $self) ;
+ }
+
+ return $self ;
+ }
+
+
+# ---------------------------------------------------------------------------
+#
+# get_values - returns the values and options
+#
+
+sub get_values
+
+ {
+ my ($self, $req) = @_ ;
+
+ return $self -> {datasrcobj} -> get_values ($req, $self) if ($self -> {datasrcobj}) ;
+ return ($self -> {values}, $self -> {options}) ;
+ }
+
+
+# ---------------------------------------------------------------------------
+#
+# get_active_id - get the id of the value which is currently active
+#
+
+sub get_active_id
+
+ {
+ my ($self, $req) = @_ ;
+
+ my ($values, $options) = $self -> get_values ($req) ;
+ my $name = $self -> {name} ;
+ my $dataval = $fdat{$name} || $values -> [0] ;
+ my $activeid ;
+
+ my $i = 0 ;
+ foreach my $val (@$values)
+ {
+ if ($val eq $dataval)
+ {
+ $activeid = "$name-$i" ;
+ last ;
+ }
+ $i++ ;
+ }
+
+ return $activeid ;
+ }
+
+
+1 ;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Embperl::Form::ControlMultValue - Base class for controls inside
+an Embperl Form which have multiple values to select from, like
+a select box or radio buttons.
+
+
+=head1 SYNOPSIS
+
+Do not use directly, instead derive a class
+
+=head1 DESCRIPTION
+
+This class is not used directly, it is used as a base class for
+all controls which have multiple values to select from inside
+an Embperl Form. It provides a set of methods
+that could be overwritten to customize the behaviour of your controls.
+
+=head1 METHODS
+
+=head2 get_values
+
+returns the values and options
+
+=head2 get_active_id
+
+get the id of the value which is currently active
+
+=head1 PARAMETERS
+
+=head3 values
+
+Arrayref with the values to select from. This is what gets
+submited back to the server.
+
+=head3 options
+
+Arrayref with the options to select from. This is what the user sees.
+
+=head3 datasrc
+
+Name of an class which provides the values for the
+values and options parameters. Either a full package name or
+a name, in which case all packages which are returned
+by Embperl::Form::get_datasrc_packages are searched.
+
+=head1 AUTHOR
+
+G. Richter (richter@dev.ecos.de)
+
+=head1 SEE ALSO
+
+perl(1), Embperl, Embperl::Form, Embperl::From::Control, Embperl::Form::DataSource
+
Modified: perl/embperl/trunk/Embperl/Form/DataSource.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/DataSource.pm?rev=410198&r1=410197&r2=410198&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/DataSource.pm (original)
+++ perl/embperl/trunk/Embperl/Form/DataSource.pm Mon May 29 23:49:55 2006
@@ -1,105 +1,105 @@
-
-###################################################################################
-#
-# Embperl - Copyright (c) 1997-2005 Gerald Richter / ecos gmbh www.ecos.de
-#
-# 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::DataSource ;
-
-use strict ;
-
-# ---------------------------------------------------------------------------
-#
-# new - create a new datasource object
-#
-
-
-sub new
-
- {
- my ($class, $args) = @_ ;
-
- my $self = {} ;
- bless $self, $class ;
-
- $self -> init ($args) ;
-
- return $self ;
- }
-
-# ---------------------------------------------------------------------------
-#
-# init - init the new datasource object
-#
-
-sub init
-
- {
- my ($self) = @_ ;
-
- return $self ;
- }
-
-# ---------------------------------------------------------------------------
-#
-# get_values - returns the values and options
-#
-
-sub get_values
-
- {
- my ($self) = @_ ;
-
- die "Please overwrite get_values in " . ref $self ;
- }
-
-1 ;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-Embperl::Form::DataSource - Base class for data source objects
-which provides the data for ControlMutlValue objects.
-
-
-=head1 SYNOPSIS
-
-Do not use directly, instead derive a class
-
-=head1 DESCRIPTION
-
-This class is not used directly, it is used as a base class for
-all data source objects.
-It provides a set of methods
-that could be overwritten to customize the behaviour of your controls.
-
-=head1 METHODS
-
-=head2 get_values
-
-returns the values and options. Must be overwritten.
-
-
-=head1 AUTHOR
-
-G. Richter (richter@dev.ecos.de)
-
-=head1 SEE ALSO
-
-perl(1), Embperl, Embperl::Form, Embperl::From::ControlMultValue
-
-
-
+
+###################################################################################
+#
+# Embperl - Copyright (c) 1997-2005 Gerald Richter / ecos gmbh www.ecos.de
+#
+# 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::DataSource ;
+
+use strict ;
+
+# ---------------------------------------------------------------------------
+#
+# new - create a new datasource object
+#
+
+
+sub new
+
+ {
+ my ($class, $args) = @_ ;
+
+ my $self = {} ;
+ bless $self, $class ;
+
+ $self -> init ($args) ;
+
+ return $self ;
+ }
+
+# ---------------------------------------------------------------------------
+#
+# init - init the new datasource object
+#
+
+sub init
+
+ {
+ my ($self) = @_ ;
+
+ return $self ;
+ }
+
+# ---------------------------------------------------------------------------
+#
+# get_values - returns the values and options
+#
+
+sub get_values
+
+ {
+ my ($self, $req) = @_ ;
+
+ die "Please overwrite get_values in " . ref $self ;
+ }
+
+1 ;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Embperl::Form::DataSource - Base class for data source objects
+which provides the data for ControlMutlValue objects.
+
+
+=head1 SYNOPSIS
+
+Do not use directly, instead derive a class
+
+=head1 DESCRIPTION
+
+This class is not used directly, it is used as a base class for
+all data source objects.
+It provides a set of methods
+that could be overwritten to customize the behaviour of your controls.
+
+=head1 METHODS
+
+=head2 get_values
+
+returns the values and options. Must be overwritten.
+
+
+=head1 AUTHOR
+
+G. Richter (richter@dev.ecos.de)
+
+=head1 SEE ALSO
+
+perl(1), Embperl, Embperl::Form, Embperl::From::ControlMultValue
+
+
+
Modified: perl/embperl/trunk/Embperl/Form/Validate.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate.pm?rev=410198&r1=410197&r2=410198&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Validate.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Validate.pm Mon May 29 23:49:55 2006
@@ -74,7 +74,7 @@
The following methods are available:
-=head2 $epf = Embperl::Form::Validate -> new ($rules [, $form_id ], [$default_language]);
+=head2 $epf = Embperl::Form::Validate -> new ($rules [, $form_id ], [$default_language], [$charset]);
Constructor for a new form validator. Returns a reference to a
Embperl::Form::Validate object.
@@ -98,6 +98,10 @@
language to use when no messages are available in the desired language.
Defaults to 'en'.
+=item $charset
+
+Pass 'utf-8' in case you want utf-8 messages.
+
=back
=cut
@@ -106,12 +110,13 @@
{
my $invokedby = shift;
my $class = ref($invokedby) || $invokedby;
- my ($frules, $form_id, $default_language) = @_ ;
+ my ($frules, $form_id, $default_language, $charset) = @_ ;
my $self = {
form_id => $form_id || 'forms[0]', # The name
frules => $frules || [], # \@frules
default_language => $default_language || 'en',
+ charset => $charset || 'iso8859-15',
};
bless($self, $class);
$self->init;
@@ -360,6 +365,7 @@
my $language = $pref -> {language} ;
my $default_language = $pref -> {default_language} ;
+ my $charset = $pref -> {charset} ;
my $txt ;
$name ||= $epreq?$epreq -> gettext($key):$key ;
@@ -368,22 +374,23 @@
my @names ;
foreach my $n (@$name)
{
- push @names, ref $n ? ($n -> {$language} || $n -> {$default_language} || (each %$n)[1] || $key):$n ;
+ push @names, ref $n ? ($n -> {"$language.$charset"} || $n -> {"$default_language.$charset"} || $n -> {$language} || $n -> {$default_language} || (each %$n)[1] || $key):$n ;
}
$name = join (', ', @names) ;
}
else
{
- $name = ref $name ? ($name -> {$language} || $name -> {$default_language} || (each %$name)[1] || $key):$name ;
+ $name = ref $name ? ($name -> {"$language.$charset"} || $name -> {"$default_language.$charset"} || $name -> {$language} || $name -> {$default_language} || (each %$name)[1] || $key):$name ;
}
if ($msg)
{
- $txt = ref $msg ? ($msg -> {$language} || $msg -> {$default_language} || (each %$msg)[1] || undef):$msg ;
+ $txt = ref $msg ? ($msg -> {"$language.$charset"} || $msg -> {"$default_language.$charset"} || $msg -> {$language} || $msg -> {$default_language} || (each %$msg)[1] || undef):$msg ;
}
else
{
- $txt = $typeobj -> getmsg ($id, $language, $default_language) ;
+ $txt = $typeobj -> getmsg ($id, "$language.$charset", "$default_language.$charset") ;
+ $txt ||= $typeobj -> getmsg ($id, $language, $default_language) ;
}
$txt = $epreq -> gettext($id) if (!$txt && $epreq) ;
$txt ||= "Missing Message $id: %0 %1 %2 %3" ;
@@ -444,6 +451,7 @@
$epreq ||= $Embperl::req ;
$pref -> {language} ||= $epreq -> param -> language if ($epreq) ;
$pref -> {default_language} ||= $self -> {default_language} ;
+ $pref -> {charset} ||= $self -> {charset} ;
my $result = $self -> validate ($fdat, $pref, $epreq) ;
return [] if (!@$result) ;
@@ -634,6 +642,7 @@
$pref ||= {} ;
$pref -> {language} ||= $epreq -> param -> language if ($epreq) ;
$pref -> {default_language} ||= $self -> {default_language} ;
+ $pref -> {charset} ||= $self -> {charset} ;
my $script ;
$script = $self -> gather_script_code ($self->{frules}, $pref, $epreq) ;
Modified: perl/embperl/trunk/Embperl/Form/Validate/Default.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/Default.pm?rev=410198&r1=410197&r2=410198&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Validate/Default.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Validate/Default.pm Mon May 29 23:49:55 2006
@@ -50,6 +50,29 @@
validate_must_not_contain => 'Das Feld %0 darf folgende Zeichen nicht enthalten: "%2"'
},
+ 'de.utf-8' =>
+ {
+ validate_required => 'Bitte Feld "%0" ausfüllen',
+ validate_eq => 'Falscher Inhalt "%1" des Feldes "%0": Erwartet wird "%2"',
+ validate_same => '"%0" stimmt nicht mit "%2" überein',
+ validate_lt => '%0 muà kleiner als %2 sein',
+ validate_gt => '%0 muà gröÃer als %2 sein',
+ validate_le => '%0 muà kleiner oder gleich wie %2 sein',
+ validate_ge => '%0 muà gröÃer oder gleich %2 sein',
+ validate_ne => '%0 muà ungleich %2 sein',
+ validate_length_max => 'Inhalt des Feldes %0 ist zu lang, maximale Länge sind %2, eingegeben wurden %1 Zeichen',
+ validate_length_min => 'Inhalt des Feldes %0 ist zu kurz, minimal Länge sind %2, eingegeben wurden %1 Zeichen',
+ validate_length_eq => 'Inhalt des Feldes %0 hat die falsche Länge: Er sollte %2 Zeichen lang sein, ist aber %1 lang',
+ validate_matches_regex => 'Inhalt "%1" des Feldes %0 entspricht nicht dem regulären Ausdruck /%2/',
+ validate_matches_regex_js => 'Inhalt "%1" des Feldes %0 entspricht nicht dem regulären Ausdruck /%2/',
+ validate_not_matches_regex => 'Inhalt "%1" des Feldes %0 darf nicht dem regulären Ausdruck /%2/ entsprechen',
+ validate_not_matches_regex_js => 'Inhalt "%1" des Feldes %0 darf nicht dem regulären Ausdruck /%2/ entsprechen',
+ validate_matches_wildcard => 'Inhalt "%1" des Feldes %0 entspricht nicht dem Wildcard-Ausdruck "%2"',
+ validate_must_only_contain => 'Das Feld %0 darf nur folgende Zeichen enthalten: "%2"',
+ validate_must_contain_one_of => 'Das Feld %0 muà mindestens eines der folgenden Zeichen enthalten: "%2"',
+ validate_must_not_contain => 'Das Feld %0 darf folgende Zeichen nicht enthalten: "%2"'
+ },
+
en =>
{
validate_required => 'Please enter a value in %0',
Modified: perl/embperl/trunk/Embperl/Form/Validate/EMail.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/EMail.pm?rev=410198&r1=410197&r2=410198&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Validate/EMail.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Validate/EMail.pm Mon May 29 23:49:55 2006
@@ -27,6 +27,12 @@
validate_email_nomailto => 'Die eingegebene E-Mail-Adresse "%0" in Feld "%1" scheint mit einem "mailto:" zu beginnen. Bitte geben Sie nur eine E-Mail-Adresse ein und keine mit "mailto:" beginnende URL.',
},
+ 'de.utf-8' =>
+ {
+ validate_email => 'Die eingegebene E-Mail-Adresse "%0" in Feld "%1" ist ungültig, sie muà genau ein "@" enthalten und darf keine Leerzeichen, Klammern oder Umlaute enthalten.',
+ validate_email_nomailto => 'Die eingegebene E-Mail-Adresse "%0" in Feld "%1" scheint mit einem "mailto:" zu beginnen. Bitte geben Sie nur eine E-Mail-Adresse ein und keine mit "mailto:" beginnende URL.',
+ },
+
en =>
{
validate_email => 'The given e-mail address "%0" in field "%1" is not valid. It must have exactly one "@" and must not contain any blanks, parentheses or special charactes like umlauts.',
Modified: perl/embperl/trunk/Embperl/Form/Validate/FQDN_IPAddr.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/FQDN_IPAddr.pm?rev=410198&r1=410197&r2=410198&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Validate/FQDN_IPAddr.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Validate/FQDN_IPAddr.pm Mon May 29 23:49:55 2006
@@ -26,6 +26,11 @@
validate_fqdn_ipaddr => 'Feld %0: "%1" ist keine gültiger Hostname oder IP-Adresse.',
},
+ 'de.utf-8' =>
+ {
+ validate_fqdn_ipaddr => 'Feld %0: "%1" ist keine gültiger Hostname oder IP-Adresse.',
+ },
+
en =>
{
validate_fqdn_ipaddr => 'Field %0: "%1" isn\\\'t a valid hostname or ip-address.',
Modified: perl/embperl/trunk/Embperl/Form/Validate/IPAddr.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/IPAddr.pm?rev=410198&r1=410197&r2=410198&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Validate/IPAddr.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Validate/IPAddr.pm Mon May 29 23:49:55 2006
@@ -26,6 +26,11 @@
validate_ipaddr => 'Feld %0: "%1" ist keine gültige IP-Adresse. Geben Sie die IP-Adresse in der Form nnn.nnn.nnn.nnn ein',
},
+ 'de.utf-8' =>
+ {
+ validate_ipaddr => 'Feld %0: "%1" ist keine gültige IP-Adresse. Geben Sie die IP-Adresse in der Form nnn.nnn.nnn.nnn ein',
+ },
+
en =>
{
validate_ipaddr => 'Field %0: "%1" isn\\\'t a valid ip-address. Please enter the ip-address as nnn.nnn.nnn.nnn',
Modified: perl/embperl/trunk/Embperl/Form/Validate/IPAddr_Mask.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/IPAddr_Mask.pm?rev=410198&r1=410197&r2=410198&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Validate/IPAddr_Mask.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Validate/IPAddr_Mask.pm Mon May 29 23:49:55 2006
@@ -26,6 +26,11 @@
validate_ipaddr_mask => 'Feld %0: "%1" ist keine gültige IP-Adresse/Netzmaske. Geben Sie die IP-Adresse/Netzmaske in der Form nnn.nnn.nnn.nnn/mm ein',
},
+ 'de.utf-8' =>
+ {
+ validate_ipaddr_mask => 'Feld %0: "%1" ist keine gültige IP-Adresse/Netzmaske. Geben Sie die IP-Adresse/Netzmaske in der Form nnn.nnn.nnn.nnn/mm ein',
+ },
+
en =>
{
validate_ipaddr_mask => 'Field %0: "%1" isn\\\'t a valid ip-address/netmask. Please enter the ip-address/netmask as nnn.nnn.nnn.nnn/mm',
Modified: perl/embperl/trunk/Embperl/Form/Validate/Number.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/Number.pm?rev=410198&r1=410197&r2=410198&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Validate/Number.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Validate/Number.pm Mon May 29 23:49:55 2006
@@ -29,6 +29,11 @@
validate_number => '%0 muß eine Zahl sein',
},
+ 'de.utf-8' =>
+ {
+ validate_number => '%0 muà eine Zahl sein',
+ },
+
en =>
{
validate_number => '%0 must be a number',
Modified: perl/embperl/trunk/Embperl/Form/Validate/TimeHHMM.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/TimeHHMM.pm?rev=410198&r1=410197&r2=410198&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Validate/TimeHHMM.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Validate/TimeHHMM.pm Mon May 29 23:49:55 2006
@@ -26,6 +26,11 @@
validate_time => 'Feld %0: "%1" ist kein gültiges Zeitformat. Geben Sie die Zeit in der Form hh:mm ein',
},
+ 'de.utf-8' =>
+ {
+ validate_time => 'Feld %0: "%1" ist kein gültiges Zeitformat. Geben Sie die Zeit in der Form hh:mm ein',
+ },
+
en =>
{
validate_time => 'Field %0: "%1" isn\\\'t a valid time. Please enter the time as hh:mm',
Modified: perl/embperl/trunk/Embperl/Form/Validate/TimeHHMMSS.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/TimeHHMMSS.pm?rev=410198&r1=410197&r2=410198&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Validate/TimeHHMMSS.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Validate/TimeHHMMSS.pm Mon May 29 23:49:55 2006
@@ -26,6 +26,11 @@
validate_time_long => 'Feld %0: "%1" ist kein gültiges Zeitformat. Geben Sie die Zeit in der Form hh:mm:ss ein',
},
+ 'de.utf-8' =>
+ {
+ validate_time_long => 'Feld %0: "%1" ist kein gültiges Zeitformat. Geben Sie die Zeit in der Form hh:mm:ss ein',
+ },
+
en =>
{
validate_time_long => 'Field %0: "%1" isn\\\'t a valid time. Please enter the time as hh:mm:ss',
Modified: perl/embperl/trunk/Embperl/Form/Validate/TimeValue.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/TimeValue.pm?rev=410198&r1=410197&r2=410198&view=diff
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Validate/TimeValue.pm (original)
+++ perl/embperl/trunk/Embperl/Form/Validate/TimeValue.pm Mon May 29 23:49:55 2006
@@ -26,6 +26,11 @@
validate_timevalue => 'Feld %0: "%1" ist keine gültige Zeit. Geben Sie eine Zahl gefolgt von s, m, h, d oder w ein.',
},
+ 'de.utf-8' =>
+ {
+ validate_timevalue => 'Feld %0: "%1" ist keine gültige Zeit. Geben Sie eine Zahl gefolgt von s, m, h, d oder w ein.',
+ },
+
en =>
{
validate_timevalue => 'Field %0: "%1" isn\\\'t a valid time value. Please enter a number followed by s, m, h, d or w.',
Modified: perl/embperl/trunk/Makefile.PL
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/Makefile.PL?rev=410198&r1=410197&r2=410198&view=diff
==============================================================================
--- perl/embperl/trunk/Makefile.PL (original)
+++ perl/embperl/trunk/Makefile.PL Mon May 29 23:49:55 2006
@@ -158,6 +158,10 @@
$txt =~ s/\@cd/\n#\t\@cd/ ; # remove tests for subdirs
$txt =~ s/\$\(NOECHO\) cd/\n#\t\$\(NOECHO\) cd/ ; # remove tests for subdirs
+ $txt =~ s/(\$\(NOECHO\) \$\(ABSPERLRUN\) \-e \'chdir)/\n#$1/ ; # remove tests for subdirs
+ $txt =~ s/-e/\n# -e/g ; # remove tests for subdirs
+
+
$txt =~ s/\r\n/\n/g ; # make doesn't like \r\n!
@@ -1297,7 +1301,7 @@
xsbuilder/source_scan.pl and xsbuilder/xs_generate.pl.
--------------------------------------------------------------------------
\n" ;
-print FH Data::Dumper -> Dump ([\%MMARGS], ['MMARGS']) ;
+print FH Data::Dumper -> Dump ([\%MMARGS, $mp2cfg, $ccdebug], ['MMARGS', 'mp2cfg', 'ccdebug']) ;
close FH ;
Modified: perl/embperl/trunk/xsbuilder/WrapXS.pm
URL: http://svn.apache.org/viewvc/perl/embperl/trunk/xsbuilder/WrapXS.pm?rev=410198&r1=410197&r2=410198&view=diff
==============================================================================
--- perl/embperl/trunk/xsbuilder/WrapXS.pm (original)
+++ perl/embperl/trunk/xsbuilder/WrapXS.pm Mon May 29 23:49:55 2006
@@ -73,7 +73,8 @@
sub makefilepl_text {
my $self = shift ;
- my $code = $self -> SUPER::makefilepl_text (@_) ;
+ my $code = "local \$mp2cfg ;\nlocal \$ccdebug ;\n" .
+ $self -> SUPER::makefilepl_text (@_) ;
$code .= q[
@@ -82,6 +83,30 @@
my ($txt) = shift -> MM::top_targets (@_) ;
$txt =~ s/config\s+pm_to_blib\s+subdirs\s+linkext/\$(O_FILES) subdirs/ ;
return $txt ;
+ }
+
+
+sub MY::cflags
+ {
+ my $self = shift ;
+
+ my $txt = $self -> MM::cflags (@_) ;
+
+ if ($mp2cfg)
+ { # with Apache 2, make sure we have the same defines as mod_perl
+ $txt =~ s/-O\d//g if ($ccdebug =~ /-O\d/) ;
+ $txt =~ /CCFLAGS\s*=(.*?)\n/s ;
+ my $flags = $mp2cfg->{MODPERL_CCOPTS} || $1 ;
+ $txt =~ s/CCFLAGS\s*=(.*?)\n/CCFLAGS = $ccdebug $flags\n/s ;
+ }
+ else
+ {
+ $txt =~ s/-O\d//g if ($ccdebug =~ /-O\d/) ;
+ $txt =~ s/CCFLAGS\s*=/CCFLAGS = $ccdebug / ;
+ }
+
+
+ return $txt ;
}
] ;
---------------------------------------------------------------------
To unsubscribe, e-mail: embperl-cvs-unsubscribe@perl.apache.org
For additional commands, e-mail: embperl-cvs-help@perl.apache.org