Commit 2951f16f authored by Jonathan Yu's avatar Jonathan Yu

[svn-upgrade] new version libembperl-perl (2.4.0)

parent cc919829
=pod
=head 2.4.0 4. Oct 2010
- Support for CGI.pm 3.43 (included within Perl 5.10.1)
for file uplaods. CGI.pm < 2.43 is not supported anymore.
- A lot of enhancements for Embperl::Form
- Add example for usage of Embperl::Form. See
eg/forms/README.txt. Can be viewed used using "make start"
- Increased size limit for errormessage from 1024 to 4096
- Makefile.PL can now handle compiling 32Bit code on 64Bit
sytsem if Perl was compiled as 32Bit application
- Adaption of tests to changed error messages of perl 5.10
- Makefile.PL can now cope with OpenSuSE 11.2, if perl,
mod_perl and apache are installed from OpenSuSE packages.
- Fix make test error for Perl compiled with DEBUGGING on
- Support for internationalization in Emberl::Form
- Do not link against unused libz
- Supports now Perl 5.12: Cope with changed flags G_ARRAY
and G_SCALAR, SVt_RV is now SVt_IV
- Fix Execute parameter app_name (was appname, but app_name
is correct, appname is still accepted, but might not always
work)
- Add parameter checks for Execute parameters to avoid segfaults
in case of non refs where refs are expected.
- Add more controls to Embperl::Form
=head1 2.3.0 30. Sept. 2007
- Added support for Code ref in language message lookup hash.
......
###################################################################################
#
# Embperl - Copyright (c) 1997-2005 Gerald Richter / ECOS
# Embperl - Copyright (c) 1997-2010 Gerald Richter / ECOS
#
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the Perl README file.
......
###################################################################################
#
# Embperl - Copyright (c) 1997-2005 Gerald Richter / ECOS
# Embperl - Copyright (c) 1997-2010 Gerald Richter / ECOS
#
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the Perl README file.
......
......@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# $Id: Embperl.pm 580573 2007-09-29 11:05:54Z richter $
# $Id: Embperl.pm 1004025 2010-10-03 18:50:24Z richter $
#
###################################################################################
......@@ -49,7 +49,7 @@ use vars qw(
@ISA = qw(Exporter DynaLoader);
$VERSION = '2.3.0' ;
$VERSION = '2.4.0' ;
if ($modperl = $ENV{MOD_PERL})
......@@ -318,8 +318,8 @@ sub get_multipart_formdata
foreach ( @$ffld )
{
# the param_fetch needs CGI.pm 2.43
#$params = $cgi->param_fetch( $_ ) ;
$params = $cgi->{$_} ;
$params = $cgi->param_fetch( $_ ) ;
#$params = $cgi->{$_} ;
if ($#$params > 0)
{
$fdat->{ $_ } = join ("\t", @$params) ;
......
......@@ -1729,10 +1729,11 @@ and developers to share ideas, solve problems and discuss things related to Embp
To subscribe to this list, send mail to embperl-subscribe@perl.apache.org.
To unsubscribe send email to embperl-unsubscribe@perl.apache.org .
There is an archive for the Embperl mailing list at http://www.ecos.de/~mailarc/embperl/
There is an archive for the Embperl mailing list at
http://mail-archives.apache.org/mod_mbox/perl-embperl
For mod_perl related questions you may search the mod_perl mailing list
archive at http://forum.swarthmore.edu/epigone/modperl
archive at http://mail-archives.apache.org/mod_mbox/perl-modperl
=head2 Commerical Support
......@@ -1793,7 +1794,7 @@ Embperl http://perl.apache.org/embperl/
Embperl (german) http://www.ecos.de/embperl/
DBIx::Recordset ftp://ftp.dev.ecos.de/pub/perl/dbi
DBIx::Recordset http://www.embperl.org/pub/perl/dbi
Apache web server http://www.apache.org/
......@@ -1803,9 +1804,9 @@ mod_perl http://perl.apache.org/dist/
Apache Perl Modules http://www.perl.com/CPAN/modules/by-module/Apache/
Embperl ftp://ftp.dev.ecos.de/pub/perl/embperl
Embperl http://www.embperl.org/pub/perl/embperl
DBIx::Recordset ftp://ftp.dev.ecos.de/pub/perl/dbi
DBIx::Recordset http://www.embperl.org/pub/perl/dbi
PPM for ActiveState
......@@ -1856,7 +1857,7 @@ be found at http://www.somewhere.com/software/
=head1 AUTHOR
G. Richter (richter@dev.ecos.de)
G. Richter (richter at embperl dot org)
=head1 SEE ALSO
......
###################################################################################
#
# Embperl - Copyright (c) 1997-2005 Gerald Richter / ECOS
# Embperl - Copyright (c) 1997-2010 Gerald Richter / ECOS
#
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the Perl README file.
......
###################################################################################
#
# Embperl - Copyright (c) 1997-2005 Gerald Richter / ecos gmbh www.ecos.de
# Embperl - Copyright (c) 1997-2010 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 diff is collapsed.
###################################################################################
#
# Embperl - Copyright (c) 1997-2005 Gerald Richter / ecos gmbh www.ecos.de
# Embperl - Copyright (c) 1997-2010 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.
......@@ -50,6 +50,16 @@ sub init
{
my ($self) = @_ ;
my $eventattrs = '' ;
if (my $e = $self -> {event})
{
for (my $i = 0; $i < @$e; $i += 2)
{
$eventattrs .= $e -> [$i] . '="' . $e -> [$i+1] . '" ' ;
}
}
$self -> {eventattrs} = $eventattrs ;
return $self ;
}
......@@ -91,6 +101,19 @@ sub is_readonly
return $self -> {readonly} ;
}
# ---------------------------------------------------------------------------
#
# is_hidden - returns true if this is a hidden control
#
sub is_hidden
{
my ($self, $req) = @_ ;
return ;
}
# ---------------------------------------------------------------------------
#
# show - output the whole control including the label
......@@ -142,6 +165,22 @@ sub form
return $Embperl::FormData::forms{$self -> {formptr}} ;
}
# ---------------------------------------------------------------------------
#
# label_text - return text of label
#
sub label_text
{
my ($self) = @_ ;
return $self -> {label_text} if ($self -> {label_text}) ;
return $self -> {label_text} = $self -> {showtext}?($self->{text} ||
$self->{name}):$self -> form -> convert_label ($self) ;
}
# ---------------------------------------------------------------------------
#
# get_validate_rules - get rules for validation
......@@ -156,12 +195,21 @@ sub get_validate_rules
{
@local_rules = ( -key => $self->{name} );
push @local_rules, -name => $self->{text} if ($self -> {text}) ;
push @local_rules, -name => $self -> label_text ;
push @local_rules, @{$self -> {validate}};
}
return \@local_rules ;
}
# ---------------------------------------------------------------------------
#
# has_auto_label_size - returns true if label should be auto sized for this control
#
sub has_auto_label_size
{
return 1 ;
}
1 ;
......@@ -197,7 +245,15 @@ $]
# show - output the label
#]
[$ sub show_label ($self, $req) $][+ $self->{text} || $self->{name} +][$endsub$]
[$ sub show_label ($self, $req) $][-
if ($self -> {showoptionslabel})
{
my $opts = $self -> form -> convert_options ($self, [$self -> {value}]) ;
$self -> {text} = $opts -> [0] ;
$self -> {showtext} = 1 ;
}
-][+ $self -> label_text +][$endsub$]
[# ---------------------------------------------------------------------------
#
......@@ -205,8 +261,8 @@ $]
#]
[$sub show_label_icon ($self, $req) $]
[$if $self -> {sublines} $]&nbsp;<img src="/images/plus.png" style="vertical-align: middle;">[$endif$]
[$if $self -> {parentid} $]&nbsp;<img src="/images/vline.png" style="vertical-align: middle;">[$endif$]
[$if $self -> {xxsublines} $]&nbsp;<img src="/images/plus.png" style="vertical-align: middle;">[$endif$]
[$if $self -> {xxparentid} $]&nbsp;<img src="/images/vline.png" style="vertical-align: middle;">[$endif$]
[$endsub$]
[# ---------------------------------------------------------------------------
......@@ -216,18 +272,32 @@ $]
[$ sub show_label_cell ($self, $req)
my $style = "";
$style = "white-space:nowrap;" if ($self->{labelnowrap}) ;
my $style = '';
my $addclass = '' ;
my $span = 20 ;
if ($self -> {width} > 2 && $self -> has_auto_label_size ())
{
$span = int(40 / $self -> {width}) if ($self -> {x_percent} != 0) ;
}
$style = 'white-space:nowrap; ' if ($self->{labelnowrap}) ;
if ($self -> {width_precent} && !$self -> {width})
{
$style .= 'width: 20%; ' ;
}
else
{
$addclass = 'cLabelBoxWidth' . ($self->{width} || 2 ) ;
}
$]
<td class="cLabelBox[$ if $self->{labelclass} $][+ " $self->{labelclass}" +][$ endif $]"
colspan="1" [$ if $style $]style="[+ $style +]"[$ endif $]>
<td class="cLabelBox [+ $addclass +] [$ if $self->{labelclass} $][+ " $self->{labelclass}" +][$ endif $]"
colspan="[+ $span +]" [$ if $style $]style="[+ $style +]"[$ endif $]>
[-
$self -> show_label ($req);
$self -> show_label_icon ($req) ;
-]
</td>
[- return 1; -]
[- return $span ; -]
[$endsub$]
[# ---------------------------------------------------------------------------
......@@ -244,6 +314,13 @@ $]
[$ sub show_control_readonly ($self, $req) $][+ $self -> {value} || $fdat{$self -> {name}} +][$endsub$]
[# ---------------------------------------------------------------------------
#
# show_control_addons - output additional things after the control
#]
[$ sub show_control_addons ($self, $req) $][$endsub$]
[# ---------------------------------------------------------------------------
#
......@@ -253,9 +330,22 @@ $]
[$ sub show_control_cell ($self, $req, $x)
my $span = $self->{width_percent} - $x ;
my $addclass = '' ;
my $style = '' ;
if ($self -> {width_precent} && !$self -> {width})
{
$style = "width: " . int($self -> {width_precent} * 100 / 80) . '; ' ;
}
else
{
$addclass = 'cControlBoxWidth' . ($self->{width} || 2 ) ;
}
$]
<td class="cControlBox" colspan="[+ $span +]">
[* my @ret = $self -> is_readonly?$self -> show_control_readonly($req):$self -> show_control ($req); *]
<td class="cControlBox [+ $addclass +]" colspan="[+ $span +]" [$ if $style $]style="[+ $style +]"[$ endif $]>
[*
my @ret = $self -> is_readonly?$self -> show_control_readonly($req):$self -> show_control ($req);
$self -> show_control_addons ($req) ;
*]
</td>
[* return @ret ; *]
[$endsub$]
......@@ -301,6 +391,10 @@ Do not display this control at all.
Could value of this control be changed ?
=head2 label_text
Returns the text of the label
=head2 show
Output the control
......@@ -343,6 +437,14 @@ Must return the columns it spans (default: 1)
Output the control itself
=head2 show_control_readonly
Output the control itself as readonly
=head2 show_control_addons
output additional things after the control
=head2 show_control_cell
Output the table cell in which the control will be displayed
......@@ -359,7 +461,18 @@ Specifies the name of the control
=head3 text
Will be used as label for the control, if not given
name is used as default
'name' is used as default.
Normaly the the name and text parameters are processed
by the method C<convert_label> of the C<Embperl::Form>
object. This method can be overwritten, to allow translation etc.
If the parameter C<showtext> is given a true value, C<convert_label>
is not called and the text is displayed as it is.
=head3 showtext
Display label without passing it through C<convert_label>. See C<text>.
=head2 labelnowrap
......
###################################################################################
#
# Embperl - Copyright (c) 1997-2005 Gerald Richter / ecos gmbh www.ecos.de
# Embperl - Copyright (c) 1997-2010 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.
......@@ -60,11 +60,10 @@ __EMBPERL__
$]
<td class="cBase cControlBox" colspan="[+ $span +]">
<td class="cBase cControlBox cControlAddRemoveBox" colspan="[+ $span +]">
<input type="hidden" id="[+ $name +]" name="[+ $name +]">
<img src="toleft.gif" title="Hinzufgen" onClick="[+ $nsprefix +]addremoveAddOption (document, document.getElementById('[+ $self->{src} +]'), document.getElementById('[+ $self->{dest} +]'), document.getElementById('[+ $name +]'), [+ $self->{removesource} +])">
<br>
<img src="toright.gif" title="Entfernen" onClick="[+ $nsprefix +]addremoveRemoveOption (document, document.getElementById('[+ $self->{src} +]'), document.getElementById('[+ $self->{dest} +]'), document.getElementById('[+ $name +]'), [+ $self->{removesource} +])">
<img src="/images/toleft.gif" title="Hinzufgen" onClick="[+ $nsprefix +]addremoveAddOption (document, document.getElementById('[+ $self->{src} +]'), document.getElementById('[+ $self->{dest} +]'), document.getElementById('[+ $name +]'), [+ $self->{removesource} +])">
<img src="/images/toright.gif" title="Entfernen" onClick="[+ $nsprefix +]addremoveRemoveOption (document, document.getElementById('[+ $self->{src} +]'), document.getElementById('[+ $self->{dest} +]'), document.getElementById('[+ $name +]'), [+ $self->{removesource} +])">
[#
print "<input class="cStandardButton" type=button value="Hinzufgen" onClick="[+ $nsprefix +]addremoveAddOption (document, this.form.elements['$self->{src}'], this.form.elements['$self->{dest}'], this.form.elements['$self->{name}'], $self->{removesource})">\n" ;
......
###################################################################################
#
# Embperl - Copyright (c) 1997-2005 Gerald Richter / ecos gmbh www.ecos.de
# Embperl - Copyright (c) 1997-2010 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.
......
###################################################################################
#
# Embperl - Copyright (c) 1997-2005 Gerald Richter / ecos gmbh www.ecos.de
# Embperl - Copyright (c) 1997-2010 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.
......@@ -37,12 +37,20 @@ $self->{button} ||= [{}] ;
$]
<td class="cBase cControlBox cControlButtonBox" colspan="[+ $span +]">
[$ foreach my $button (@{$self->{button}}) $]
[$if $self -> {symbol} $]
<div class="cControlButtonDiv"
title="[+ $self -> {showtext}?($self->{text}):$self -> form -> convert_label ($self) +]"
[$if $self -> {onclick} $] onClick="[+ do { local $escmode = 0 ; $self -> {onclick} } +]" [$endif$]
><img class="cControlButtonSymbol" src="[+ $self -> {symbol} +]">
[+ $self -> {showvalue}?($self -> {value} || $self->{text}):$self -> form -> convert_label ($self) +]
</div>
[$else$]
[# Workaround around segfault in Embperl 2.1.1-dev *grmpf* #]
<[# #]input
class="cBase cControl cControlButton" name="[+ $self->{name} +]"
value="[+ $self->{value} || $self->{text} +]"
title="[+ $self->{text} +]"
[$if $self -> {onclick} $] onClick="[+ $self -> {onclick} +]" [$endif$]
value="[+ $self -> {showvalue}?($self -> {value} || $self->{text}):$self -> form -> convert_label ($self) +]"
title="[+ $self -> {showtext}?($self->{text}):$self -> form -> convert_label ($self) +]"
[$if $self -> {onclick} $] onClick="[+ do { local $escmode = 0 ; $self -> {onclick} } +]" [$endif$]
[$if $self -> {image} $]
type="image" src="[+ $self -> {image} +]"
[$else$]
......@@ -57,6 +65,7 @@ $]
[+ $attr +]="[+ $button->{$attr} +]"
[$ endif $]
[$ endforeach $]>
[$endif$]
[$ endforeach $]
</td>
......
###################################################################################
#
# Embperl - Copyright (c) 1997-2005 Gerald Richter / ecos gmbh www.ecos.de
# Embperl - Copyright (c) 1997-2010 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.
......@@ -41,6 +41,35 @@ sub get_active_id
}
# ---------------------------------------------------------------------------
#
# has_auto_label_size - returns true if label should be auto sized for this control
#
sub has_auto_label_size
{
return 0 ;
}
# ---------------------------------------------------------------------------
#
# show_control_readonly - output readonly control
#
sub show_control_readonly
{
my ($self, $req) = @_ ;
my $name = $self -> {name} ;
my $val = $self -> {value} ;
$val = 1 if ($val eq '') ;
$self -> {value} = $fdat{$name} eq $val?'X':'-' ;
$self -> SUPER::show_control_readonly ($req) ;
}
1 ;
__EMBPERL__
......@@ -60,7 +89,7 @@ __EMBPERL__
$]
<input type="checkbox" class="cBase cControlCheckbox" name="[+ $name +]" value="[+ $val +]"
[$if ($self -> {sublines} || $self -> {subobjects}) $] OnClick="[+ $nsprefix +]show_checked(document, this)" [$endif$]
>
[+ do { local $escmode = 0 ; $self -> {eventattrs} } +]>
[$endsub$]
__END__
......
###################################################################################
#
# Embperl - Copyright (c) 1997-2005 Gerald Richter / ecos gmbh www.ecos.de
# Embperl - Copyright (c) 1997-2010 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.
......@@ -32,7 +32,15 @@ sub show_control_readonly
my ($self, $req) = @_ ;
my $name = $self -> {name} ;
$self -> show_control ($req, "^\Q$fdat{$name}\\E\$") ;
$self -> show_control ($req, "^\Q$fdat{$name}\E\$") ;
}
# ---------------------------------------------------------------------------
sub show_control_addons
{
my ($self, $req) = @_ ;
}
1 ;
......@@ -53,34 +61,51 @@ __EMBPERL__
my $addbottom= $self -> {addbottom} || [] ;
my $max = @$values ;
my $set = !defined ($fdat{$name})?1:0 ;
my $tab = $self -> {tab} ;
my $colcnt = 0 ;
push @{$self -> form -> {fields2empty}}, $name ;
my $val ;
my $i = 0 ;
$]
[$if $tab $]<[# #]table>[$ endif $]
[$ foreach $val (@$addtop) $]
[$if !defined ($filter) || ($val->[0] =~ /$filter/i) $]
[- $fdat{$name} = $val -> [0], $set = 0 if ($set) ; -]
<input type="checkboxes" name="[+ $name +]" value="[+ $val -> [0] +]"
>[+ $val ->[1] || $val -> [0] +]
[$ if $tab $][$ if $colcnt == 0 $]<[# #]tr>[- $colcnt = $tab -][$endif$]<td>[$endif$]
[#- $fdat{$name} = $val -> [0], $set = 0 if ($set) ; -#]
<input type="checkbox" name="[+ $name +]" value="[+ $val -> [0] +]"
>
[$ if $tab $]</td><td>[$endif$]
[+ $val ->[1] || $val -> [0] +]
[$ if $tab $]</td>[$ if $colcnt-- < 1 $]<[# #]/tr>[$endif$][$endif$]
[$endif$]
[$endforeach$]
[$ foreach $val (@$values) $]
[$if !defined ($filter) || ($val =~ /$filter/i) $]
[- $fdat{$name} = $val, $set = 0 if ($set) ; -]
[$ if $tab $][$ if $colcnt == 0 $]<[# #]tr>[- $colcnt = $tab -][$endif$]<td>[$endif$]
[#- $fdat{$name} = $val, $set = 0 if ($set) ; -#]
<input type="checkbox" name="[+ $name +]" value="[+ $val +]"
[$if ($self -> {sublines} || $self -> {subobjects}) $] OnClick="show_checkboxes_checked(this,[+ $i +],[+ $max +])" [$endif$]
>[+ $options ->[$i] || $val +]
>
[$ if $tab $]</td><td>[$endif$]
[+ $options ->[$i] || $val +]
[- $vert = $self -> {vert} -][$while $vert-- > 0 $]<br/>[$endwhile$]
[$ if $tab $]</td>[$ if $colcnt-- < 1 $]<[# #]/tr>[$endif$][$endif$]
[$endif$]
[* $i++ ; *]
[$endforeach$]
[$ foreach $val (@$addbottom) $]
[$if !defined ($filter) || ($val->[0] =~ /$filter/i) $]
[- $fdat{$name} = $val -> [0], $set = 0 if ($set) ; -]
<input type="checkboxes" name="[+ $name +]" value="[+ $val -> [0] +]"
>[+ $val ->[1] || $val -> [0] +]
[$ if $tab $][$ if $colcnt == 0 $]<[# #]tr>[- $colcnt = $tab -][$endif$]<td>[$endif$]
[#- $fdat{$name} = $val -> [0], $set = 0 if ($set) ; -#]
<input type="checkbox" name="[+ $name +]" value="[+ $val -> [0] +]"
>
[$ if $tab $]</td><td>[$endif$]
[+ $val ->[1] || $val -> [0] +]
[$ if $tab $]</td>[$ if $colcnt-- < 1 $]<[# #]/tr>[$endif$][$endif$]
[$endif$]
[$endforeach$]
[$if $tab $]<[# #]/table>[$ endif $]
[$endsub$]
......@@ -138,6 +163,11 @@ If no options are given, the values from values are used.
If specified arranges the checkboxes button vertically. The number given specifies
the number of <br>'s used the separate the checkboxes buttons.
=head3 tab
if specified arranges the checkboxes in a table. The number given
specifies the number of columns in one table row.
=head3 addtop
Array ref which contains items that should be added at the left or top
......
###################################################################################
#
# Embperl - Copyright (c) 1997-2010 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::Control::datetime ;
use strict ;
use base 'Embperl::Form::Control::number' ;
use Embperl::Inline ;
use POSIX qw(strftime);
use Time::Local qw(timelocal_nocheck timegm_nocheck);
use Date::Calc qw{Delta_DHMS Add_Delta_Days} ;
use vars qw{%fdat} ;
our $tz_local = (timegm_nocheck(localtime())-time())/60;
# ---------------------------------------------------------------------------
#
# init - init the new control
#
sub init
{
my ($self) = @_ ;
$self->{unit} ||= '' ;
return $self ;
}
# ------------------------------------------------------------------------------------------
#
# init_data - daten aufteilen
#
sub init_data
{
my ($self, $req, $parentctrl) = @_ ;