richter 02/03/01 07:29:34
Modified: Embperl Tag: Embperl2c Object.pm
Embperl/Form Tag: Embperl2c Validate.pm
Embperl/Form/Validate/Rules Tag: Embperl2c String.pm
Embperl/Syntax Tag: Embperl2c POD.pm
eg/web/db Tag: Embperl2c addsel.epl epwebapp.pl
Log:
EO
Revision Changes Path
No revision
No revision
1.1.2.13 +31 -18 embperl/Embperl/Attic/Object.pm
Index: Object.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Attic/Object.pm,v
retrieving revision 1.1.2.12
retrieving revision 1.1.2.13
diff -u -r1.1.2.12 -r1.1.2.13
--- Object.pm 1 Mar 2002 08:24:37 -0000 1.1.2.12
+++ Object.pm 1 Mar 2002 15:29:34 -0000 1.1.2.13
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Object.pm,v 1.1.2.12 2002/03/01 08:24:37 richter Exp $
+# $Id: Object.pm,v 1.1.2.13 2002/03/01 15:29:34 richter Exp $
#
###################################################################################
@@ -120,6 +120,8 @@
my ($rc, $r) = Embperl::Req::InitRequest ($req -> {req_rec}, $req) ;
return $rc if ($rc) ;
+ warn "r = $r er = $Embperl::req ea = " . $r -> app ;
+
my $app = $r -> app ;
my $appcfg = $app -> config;
@@ -207,9 +209,7 @@
my $basepackage = $packages{$fn} ;
-
-
- my $package = $packages{$filename} ;
+ my $package = $packages{$filename} ;
if (!$basepackage)
{
@@ -220,19 +220,26 @@
$basepackage = $packages{$fn} = $c -> curr_package if (!$r -> error) ;
$c -> cleanup ;
print Embperl::LOG "[$$]Embperl::Object import base ", ($r ->
error?'with ERRORS ':'') . "finished: $fn, " . ($basepackage?"package = $basepackage
\n":"\n") if ($debug);
- }
+
+ if (!$r -> error)
+ {
no strict ;
- if (!@{"$basepackage\:\:ISA"} && !$r -> error)
- {
- @{"$basepackage\:\:ISA"} = ($appcfg -> object_handler_class ||
'Embperl::Req') ;
- }
+ my $isa = \@{"$package\:\:ISA"} ;
+ my $class = $appcfg -> object_handler_class || 'Embperl::Req' ;
+ if (!grep /^\Q$class\E$/, @$isa)
+ {
+ push @{"$basepackage\:\:ISA"}, $class ;
+ }
+ }
use strict ;
+ }
$r -> config -> path (\@searchpath) ;
if ($appcfg -> object_app && !$r -> error)
{
my $appfn = $appcfg -> object_app ;
+
print Embperl::LOG "[$$]Embperl::Object import new Application:
$appfn\n" if ($debug);
my $cparam = {object => $appfn, syntax => 'Perl'} ;
@@ -245,9 +252,10 @@
if (!$r -> error)
{
no strict ;
- if (!@{"$package\:\:ISA"})
+ my $isa = \@{"$package\:\:ISA"} ;
+ if (!grep /^Embperl::App$/, @$isa)
{
- @{"$package\:\:ISA"} = ("Embperl::App") if ($package ne
$basepackage) ;
+ push @{"$package\:\:ISA"}, 'Embperl::App' ;
}
use strict ;
@@ -293,17 +301,22 @@
$package = $packages{$filename} = $c -> curr_package if (!$r -> error);
$c -> cleanup ;
print Embperl::LOG "[$$]Embperl::Object import finished: $filename,
package = $package\n" if ($debug);
- }
- if (!$r -> error)
- {
- no strict ;
- if (!@{"$package\:\:ISA"})
+ if (!$r -> error && $package ne $basepackage)
{
- @{"$package\:\:ISA"} = ($basepackage) if ($package ne $basepackage)
;
+ no strict ;
+ my $isa = \@{"$package\:\:ISA"} ;
+ if (!grep /^\Q$basepackage\E$/, @$isa)
+ {
+ push @{"$package\:\:ISA"}, $basepackage ;
+ }
}
- use strict ;
+ use strict ;
+
+ }
+ if (!$r -> error)
+ {
$r -> param -> filename ($filename) if ($filename ne $fn) ;
bless $r, $package ;
}
No revision
No revision
1.1.2.3 +20 -22 embperl/Embperl/Form/Attic/Validate.pm
Index: Validate.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Form/Attic/Validate.pm,v
retrieving revision 1.1.2.2
retrieving revision 1.1.2.3
diff -u -r1.1.2.2 -r1.1.2.3
--- Validate.pm 1 Mar 2002 08:24:37 -0000 1.1.2.2
+++ Validate.pm 1 Mar 2002 15:29:34 -0000 1.1.2.3
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Validate.pm,v 1.1.2.2 2002/03/01 08:24:37 richter Exp $
+# $Id: Validate.pm,v 1.1.2.3 2002/03/01 15:29:34 richter Exp $
#
###################################################################################
@@ -20,7 +20,7 @@
use strict;
use vars qw($VERSION);
-$VERSION = q$Id: Validate.pm,v 1.1.2.2 2002/03/01 08:24:37 richter Exp $;
+$VERSION = q$Id: Validate.pm,v 1.1.2.3 2002/03/01 15:29:34 richter Exp $;
=head1 NAME
@@ -93,9 +93,7 @@
The following methods are available:
-=over 4
-
-=item $epf = new Embperl::Form::Validate($rules [, $form_id [, $msg_module]]);
+=head2 $epf = new Embperl::Form::Validate($rules [, $form_id [, $msg_module]]);
Constructor for the new form validator. Returns a reference to a
Embperl::Form::Validate object.
@@ -150,7 +148,7 @@
return 1;
}
-=item $epf->add_rules($field, $field_rules);
+=head2 $epf->add_rules($field, $field_rules);
Adds rules $field_rules for a (new) field $field to the validator,
e.g.
@@ -173,7 +171,7 @@
return 1;
}
-=item $epf->validate($fdat, $pref);
+=head2 $epf->validate($fdat, $pref);
Verifies the content $fdat according to the rules given to the
Embperl::Form::Validate
constructor and added by $pef->add_rule() and returns a hash or hash
@@ -258,7 +256,7 @@
undef);
}
-=item $epf->generate_error_message($error,$language);
+=head2 $epf->generate_error_message($error,$language);
Generates a (usually :-) natural language form of the error array
reference $error in $language (usually according to ISO-3166). See
@@ -350,7 +348,7 @@
return $result;
}
-=item $epf->validate_messages($fdat, $pref);
+=head2 $epf->validate_messages($fdat, $pref);
Verifies the content $fdat according to the rules given to the
Embperl::Form::Validate
constructor and added by $pef->add_rule() and returns an array of
@@ -381,13 +379,13 @@
return @messages;
}
-=item $epf->get_scripting_functions($pref, $script_lang);
+=head2 $epf->get_scripting_functions($pref, $script_lang);
-=item $epf->get_scripting_functions($script_lang);
+=head2 $epf->get_scripting_functions($script_lang);
-=item $epf->get_scripting_functions($pref);
+=head2 $epf->get_scripting_functions($pref);
-=item $epf->get_scripting_functions();
+=head2 $epf->get_scripting_functions();
Generates the code for the client-side scripting functions in the
scripting language $script_lang (defaults to 'javascript') for the
@@ -721,13 +719,13 @@
return [@functions];
}
-=item $epf->get_scripting_calls($pref, $script_lang [, $key]);
+=head2 $epf->get_scripting_calls($pref, $script_lang [, $key]);
-=item $epf->get_scripting_calls($script_lang [, $key]);
+=head2 $epf->get_scripting_calls($script_lang [, $key]);
-=item $epf->get_scripting_calls($pref [, $key]);
+=head2 $epf->get_scripting_calls($pref [, $key]);
-=item $epf->get_scripting_calls();
+=head2 $epf->get_scripting_calls();
Generates the code for the calls of the functions generated by the
method get_scripting_functions() in the scripting language
@@ -948,13 +946,13 @@
return @calls;
}
-=item $epf->sprint_scripting_code($pref, $script_lang [, $key]);
+=head2 $epf->sprint_scripting_code($pref, $script_lang [, $key]);
-=item $epf->sprint_scripting_code($script_lang [, $key]);
+=head2 $epf->sprint_scripting_code($script_lang [, $key]);
-=item $epf->sprint_scripting_code($pref [, $key]);
+=head2 $epf->sprint_scripting_code($pref [, $key]);
-=item $epf->sprint_scripting_code();
+=head2 $epf->sprint_scripting_code();
Returns the code for the calls and functions ready to insert into a
<SCRIPT> container or an ONSUBMIT parameter in the scripting language
@@ -1170,7 +1168,7 @@
optional defaults to the name of the field
-=ietm * 'messages'
+=item * 'messages'
contains field specific error messages. optional.
No revision
No revision
1.1.2.2 +21 -15 embperl/Embperl/Form/Validate/Rules/Attic/String.pm
Index: String.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Form/Validate/Rules/Attic/String.pm,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -u -r1.1.2.1 -r1.1.2.2
--- String.pm 27 Feb 2002 15:42:50 -0000 1.1.2.1
+++ String.pm 1 Mar 2002 15:29:34 -0000 1.1.2.2
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: String.pm,v 1.1.2.1 2002/02/27 15:42:50 richter Exp $
+# $Id: String.pm,v 1.1.2.2 2002/03/01 15:29:34 richter Exp $
#
###################################################################################
@@ -23,7 +23,7 @@
use vars qw($VERSION %error_messages %script_functions %prefixes);
no strict 'refs';
-$VERSION = q$Id: String.pm,v 1.1.2.1 2002/02/27 15:42:50 richter Exp $;
+$VERSION = q$Id: String.pm,v 1.1.2.2 2002/03/01 15:29:34 richter Exp $;
### Global variables inside the module
@@ -32,27 +32,27 @@
de =>
{
string_eq => 'Falscher Inhalt \'$value\' des Feldes $name: Erwartet wird
\'$should\'',
- string_length_max => 'Inhalt des Feldes $name ist zu lang: $is > $should',
- string_length_min => 'Inhalt des Feldes $name ist zu kurz: $is < $should',
+ string_length_max => 'Inhalt des Feldes $name ist zu lang, maximale L�nge sind
$should, eigegeben wurden $is Zeichen',
+ string_length_min => 'Inhalt des Feldes $name ist zu kurz, minimal L�nge sind
$should, eigegeben wurden $is Zeichen',
string_length_eq => 'Inhalt des Feldes $name hat die falsche L�nge: Er sollte
$should Zeichen lang sein, ist aber $is lang',
string_matches_regexp => 'Inhalt \'$value\' des Feldes $name entspricht nicht
dem regul�ren Ausdruck /$should/',
string_matches_wildcard => 'Inhalt \'$value\' des Feldes $name entspricht
nicht dem Wildcard-Ausdruck \'$should\'',
- string_must_only_contain => 'Inhalt \'$value\' des Feldes $name enth�lt andere
Zeichen als \'$should\'',
- string_must_contain_one_of => 'Inhalt \'$value\' des Feldes $name enth�lt
keines der Zeichen \'$should\'',
- string_must_not_contain => 'Inhalt \'$value\' des Feldes $name enth�lt
mindestens eines Zeichen \'$should\''
+ string_must_only_contain => 'Das Feld $name darf nur folgende Zeichen
enthalten: \'$should\'',
+ string_must_contain_one_of => 'Das Feld $name mu� mindestens eines der
folgenden Zeichen enthalten: \'$should\'',
+ string_must_not_contain => 'Das Feld $name darf folgende Zeichen nicht
enthalten: \'$should\''
},
en =>
{
- string_eq => 'Wrong content \'$value\' of field $name: Expected is
\'$should\'',
- string_length_max => 'Content of field $name is too long: $is > $should',
- string_length_min => 'Content of field $name is too short: $is < $should',
+ string_eq => 'Wrong content \'$value\' of field $name: Expected \'$should\'',
+ string_length_max => 'Content of field $name is too long, has $is characters,
maximum is $should characters',
+ string_length_min => 'Content of field $name is too short, has $is characters,
minimum is $should characters',
string_length_eq => 'Content of field $name has wrong length: It is $is
characters long, but should be $should characters long',
- string_matches_regexp => 'Content \'$value\' of field $name doesn\'t match
regexp /$should/',
- string_matches_wildcard => 'Content \'$value\' of field $name doesn\'t match
wildcard expression \'$should\'',
- string_must_only_contain => 'Content \'$value\' of field $name contains
characters other than \'$should\'',
- string_must_contain_one_of => 'Content \'$value\' of field $name doesn\'t
contain any of the following characters \'$should\'',
- string_must_not_contain => 'Content \'$value\' of field $name contains at
least one of the following characters: \'$should\''
+ string_matches_regexp => 'Field $name doesn\'t match regexp /$should/',
+ string_matches_wildcard => 'Field $name doesn\'t match wildcard expression
\'$should\'',
+ string_must_only_contain => 'Field $name must contain only the following
characters: \'$should\'',
+ string_must_contain_one_of => 'Field $name must contain one of the following
characters: \'$should\'',
+ string_must_not_contain => 'Field $name must not contain the following
characters: \'$should\''
}
);
@@ -71,6 +71,7 @@
'"+eq+"',
'"+object.value+"',
'"+object.value+"'],
+
string_length_max =>
['function EPForm_validate_string_length_max (object, desc, max) {
if (object.value.length > max) {
@@ -94,6 +95,7 @@
'"+min+"',
'"+object.value.length+"',
'"+object.value+"'],
+
string_length_eq =>
['function EPForm_validate_string_length_eq (object, desc, eq) {
if (object.value.length == eq) {
@@ -105,6 +107,7 @@
'"+eq+"',
'"+object.value.length+"',
'"+object.value+"'],
+
# string_matches_regexp =>
# ['function EPForm_validate_string_matches_regexp (object, desc, regexp) {
# if (object.value.search(regexp) == -1) {
@@ -122,6 +125,7 @@
# EPForm_validate_string_matches_wildcard in JS
# string_matches_wildcard => [],
+
string_must_only_contain =>
['function EPForm_validate_string_must_only_contain (object, desc, moc) {
var re = new RegExp("^["+moc+"]*$");
@@ -134,6 +138,7 @@
'"+moc+"',
'"+object.value+"',
'"+object.value+"'],
+
string_must_contain_one_of =>
['function EPForm_validate_string_must_contain_one_of (object, desc, mcoo) {
var re = new RegExp("["+mcoo+"]");
@@ -146,6 +151,7 @@
'"+mcoo+"',
'"+object.value+"',
'"+object.value+"'],
+
string_must_not_contain =>
['function EPForm_validate_string_must_not_contain (object, desc, mnc) {
var re = new RegExp("["+mnc+"]");
No revision
No revision
1.1.2.13 +1 -2 embperl/Embperl/Syntax/Attic/POD.pm
Index: POD.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl/Syntax/Attic/POD.pm,v
retrieving revision 1.1.2.12
retrieving revision 1.1.2.13
diff -u -r1.1.2.12 -r1.1.2.13
--- POD.pm 1 Mar 2002 08:24:37 -0000 1.1.2.12
+++ POD.pm 1 Mar 2002 15:29:34 -0000 1.1.2.13
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: POD.pm,v 1.1.2.12 2002/03/01 08:24:37 richter Exp $
+# $Id: POD.pm,v 1.1.2.13 2002/03/01 15:29:34 richter Exp $
#
###################################################################################
@@ -519,7 +519,6 @@
'cdatatype' => 0,
'exitinside' => 1,
},
- %Skip,
# %Para,
) ;
No revision
No revision
1.1.2.3 +8 -6 embperl/eg/web/db/Attic/addsel.epl
Index: addsel.epl
===================================================================
RCS file: /home/cvs/embperl/eg/web/db/Attic/addsel.epl,v
retrieving revision 1.1.2.2
retrieving revision 1.1.2.3
diff -u -r1.1.2.2 -r1.1.2.3
--- addsel.epl 27 Feb 2002 15:42:50 -0000 1.1.2.2
+++ addsel.epl 1 Mar 2002 15:29:34 -0000 1.1.2.3
@@ -1,15 +1,17 @@
[-
$r = shift ;
- my $langset = $r -> {language_set} ;
- $$langset -> Reset ;
- while ($rec = $$langset -> Next)
- {
- $rules{"category_$rec->{id}"} = {type => 'String', length_min => 5, emptyok
=> 1} ;
- }
+my $langset = $r -> {language_set} ;
+$$langset -> Reset ;
+while ($rec = $$langset -> Next)
+ {
+ $rules{"category_$rec->{id}"} = {type => 'String', length_min => 5, emptyok =>
1, name => $rec -> {name}} ;
+ }
use Embperl::Form::Validate ;
$epf = Embperl::Form::Validate -> new (\%rules) ;
+
+$Embperl::Form::Validate::objects{'addsel'} = $epf ;
-]
<script>
1.1.2.5 +1 -1 embperl/eg/web/db/Attic/epwebapp.pl
Index: epwebapp.pl
===================================================================
RCS file: /home/cvs/embperl/eg/web/db/Attic/epwebapp.pl,v
retrieving revision 1.1.2.4
retrieving revision 1.1.2.5
diff -u -r1.1.2.4 -r1.1.2.5
--- epwebapp.pl 12 Feb 2002 21:02:42 -0000 1.1.2.4
+++ epwebapp.pl 1 Mar 2002 15:29:34 -0000 1.1.2.5
@@ -2,7 +2,7 @@
use DBIx::Recordset ;
-BEGIN { Execute ({isa => '../epwebapp.pl'}) ; }
+BEGIN { Execute ({isa => '../epwebapp.pl', syntax => 'Perl'}) ; }
sub init
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
