Author: richter
Date: Tue Jan 15 13:34:44 2013
New Revision: 1433408
URL: http://svn.apache.org/viewvc?rev=1433408&view=rev
Log:
dynamic link control
Added:
perl/embperl/trunk/Embperl/Form/Control/dynlink.pm
perl/embperl/trunk/Embperl/Form/Validate/IPAddr_orRange.pm
Added: perl/embperl/trunk/Embperl/Form/Control/dynlink.pm
URL:
http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Control/dynlink.pm?rev=1433408&view=auto
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Control/dynlink.pm (added)
+++ perl/embperl/trunk/Embperl/Form/Control/dynlink.pm Tue Jan 15 13:34:44 2013
@@ -0,0 +1,139 @@
+
+###################################################################################
+#
+# 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::dynlink ;
+
+use strict ;
+use base 'Embperl::Form::Control' ;
+
+use Embperl::Inline ;
+
+# ---------------------------------------------------------------------------
+#
+# show_control_readonly - output readonly control
+#
+
+sub show_control_readonly
+ {
+ my ($self, $req) = @_ ;
+
+ $self -> show_control ($req) ;
+ }
+
+1 ;
+
+__EMBPERL__
+
+[# ---------------------------------------------------------------------------
+#
+# show_control - output the control
+#]
+
+[$ sub show_control ($self)
+
+my $name = $self->{name};
+my $fields = $self -> {fields} ;
+my $form = $self -> form ;
+my $showoptions = $self -> {showoptions} ;
+my $state = $self -> {state} ;
+
+$]
+<div [+ do { local $escmode = 0 ; $self -> get_std_control_attr($req) } +]>
+[$ foreach $field (@$fields) $]
+ <a class="[+ $state +]" [+ do { local $escmode = 0 ; $self ->
{eventattrs} } +] _ef_attach="ef_dynlink"
+ [$if $field -> {target} $]target="[+ $field -> {target} +]" [$endif$]
+ [$if $field -> {href} $]href="[+ do { local $escmode = 0 ; $field ->
{href} } +]" _hreforg="[+ do { local $escmode = 0 ; $field -> {href} } +]"
[$endif$]
+ [+ do { local $escmode = 0 ; $self -> {eventattrs} } +]>
+ [$ if $showoptions < 0 $][+ do { local $escmode = 0 ; $field ->
{text} } +][$else$][+ $showoptions?$field -> {text}:$form -> convert_text
($self, $field -> {name}) +][$endif$]
+ </a>
+[$endforeach$]
+</div>
+__END__
+
+=pod
+
+=head1 NAME
+
+Embperl::Form::Control::dynlink - A control to display dynamic links inside an
Embperl Form
+
+
+=head1 SYNOPSIS
+
+ {
+ type => 'dynlink',
+ text => 'blabla',
+ fields =>
+ [
+ { name => 'foo', text => 'Foo', href => 'http://www.ecos.de' },
+ { name => 'bar', text => 'Bar', href => 'http://www.embperl.org', target
=> 'newwindow' },
+ ]
+ }
+
+=head1 DESCRIPTION
+
+Used to create a control which displays links inside an Embperl Form.
+The link destination can be dynamicly altered with values from other input
fields
+See Embperl::Form on how to specify parameters.
+
+=head2 PARAMETER
+
+=head3 type
+
+Needs to be set to 'dynlink'.
+
+=head3 text
+
+Will be used as label for the text display control.
+
+=head3 fields
+
+Arrayref with one or more links. Contains hashrefs with the following keys:
+
+=head4 name
+
+Name of the link
+
+=head4 text
+
+Text to display for the link
+
+=head4 href
+
+Link destination
+
+<name> is replaced by with the content of the field inside the same form with
name name.
+This is done when the link is clicked, so modifing the content of the input
field,
+will modify the link. The content is url escaped before it it inserted inside
the link.
+
+=head4 target
+
+Link target
+
+<name> is replaced by with the content of the field inside the same form with
name name.
+This is done when the link is clicked, so modifing the content of the input
field,
+will modify the link. The content is url escaped before it it inserted inside
the link.
+
+
+=head1 Author
+
+G. Richter (richter at embperl dot org)
+
+=head1 See Also
+
+perl(1), Embperl, Embperl::Form
+
+
Added: perl/embperl/trunk/Embperl/Form/Validate/IPAddr_orRange.pm
URL:
http://svn.apache.org/viewvc/perl/embperl/trunk/Embperl/Form/Validate/IPAddr_orRange.pm?rev=1433408&view=auto
==============================================================================
--- perl/embperl/trunk/Embperl/Form/Validate/IPAddr_orRange.pm (added)
+++ perl/embperl/trunk/Embperl/Form/Validate/IPAddr_orRange.pm Tue Jan 15
13:34:44 2013
@@ -0,0 +1,91 @@
+
+###################################################################################
+#
+# Embperl - Copyright (c) 1997-2002 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: Integer.pm,v 1.1 2002/11/20 07:00:18 richter Exp $
+#
+###################################################################################
+
+
+package Embperl::Form::Validate::IPAddr_orRange ;
+
+use base qw(Embperl::Form::Validate::Default);
+
+my %error_messages =
+(
+ de =>
+ {
+ validate_ipaddr_or_range => 'Feld %0: "%1" ist kein gültiger
IP-Adressbereich. Geben Sie die IP-Adress Bereich in der Form
nnn.nnn.nnn.nnn-nnn oder nnn.nnn.nnn.nnn ein.',
+ },
+
+ en =>
+ {
+ validate_ipaddr_or_range => 'Field %0: "%1" isn\\\'t a valid
ip-address-range. Please enter the ip-address range as nnn.nnn.nnn.nnn-nnn or
nnn.nnn.nnn.nnn.',
+ }
+ );
+
+# --------------------------------------------------------------
+
+sub getmsg
+ {
+ my ($self, $id, $language, $default_language) = @_ ;
+
+ return $error_messages{$language}{$id} ||
+ $error_messages{$default_language}{$id} ||
+ $self -> SUPER::getmsg ($id, $language, $default_language) ;
+ }
+
+
+# --------------------------------------------------------------
+
+sub validate
+ {
+ my ($self, $key, $value, $fdat, $pref) = @_ ;
+
+ if ($value =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)-(\d+)$/)
+ {
+ if ($1 < 0 || $1 > 255 ||
+ $2 < 0 || $2 > 255 ||
+ $3 < 0 || $3 > 255 ||
+ $4 < 0 || $4 > 255 ||
+ $5 < 0 || $5 > 255 ||
+ $5 <= $4)
+ {
+ return ['validate_ipaddr_or_range', $value] ;
+ }
+ return undef ;
+ }
+ elsif ($value =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)
+ {
+ if ($1 < 0 || $1 > 255 ||
+ $2 < 0 || $2 > 255 ||
+ $3 < 0 || $3 > 255 ||
+ $4 < 0 || $4 > 255)
+ {
+ return ['validate_ipaddr_or_range', $value] ;
+ }
+ return undef ;
+ }
+
+ return ['validate_ipaddr_or_range', $value] ;
+ }
+
+# --------------------------------------------------------------
+
+sub getscript_validate
+ {
+ my ($self, $arg, $pref) = @_ ;
+
+ return
('obj.value.search(/(^\d+\.\d+.\d+.\d+\-\d+$)|(^\d+\.\d+.\d+.\d+$)/) >= 0',
['validate_ipaddr_or_range', "'+obj.value+'"]) ;
+ }
+
+
+1;
---------------------------------------------------------------------
To unsubscribe, e-mail: embperl-cvs-unsubscr...@perl.apache.org
For additional commands, e-mail: embperl-cvs-h...@perl.apache.org
