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 2005/08/07 17:59:09 UTC
cvs commit: embperl/eg/webutil db.schema
richter 2005/08/07 08:59:09
Modified: . Changes.pod README
eg/web config.pl epwebapp.pl messages.pl
eg/web/db add.epl addsel.epl content.epl epwebapp.pl
list.epl loginform.epl show.epl updateditem.mail
eg/webutil db.schema
Log:
docs
Revision Changes Path
1.284 +1 -1 embperl/Changes.pod
Index: Changes.pod
===================================================================
RCS file: /home/cvs/embperl/Changes.pod,v
retrieving revision 1.283
retrieving revision 1.284
diff -u -r1.283 -r1.284
--- Changes.pod 7 Aug 2005 14:40:39 -0000 1.283
+++ Changes.pod 7 Aug 2005 15:59:08 -0000 1.284
@@ -1,7 +1,7 @@
=pod
-=head4 2.0rc5
+=head4 2.0rc5 7. August 2005
- Added attribute content-type to mail:send tag (Syntax Mail).
Patch from Axel Beckert.
1.41 +5 -2 embperl/README
Index: README
===================================================================
RCS file: /home/cvs/embperl/README,v
retrieving revision 1.40
retrieving revision 1.41
diff -u -r1.40 -r1.41
--- README 7 Aug 2005 00:02:58 -0000 1.40
+++ README 7 Aug 2005 15:59:08 -0000 1.41
@@ -132,7 +132,7 @@
perl5.005_01/02/03
perl5.6.1
perl5.8.x
-apache_1.3.0 - apache_1.3.31, - apache 2.0.50
+apache_1.3.0 - apache_1.3.31, - apache 2.0.x
apache + mod_ssl
apache_ssl (Ben SSL)
Stronghold 2.2
@@ -146,6 +146,9 @@
perl5.8.x
apache_1.3.0 - apache_1.3.31
+Apache 2 is currently not supported on Windows.
+This is planned for Embperl 2.1
+
on Windows 95/98 with
perl5.004_02 (binary distribution)
1.11 +1 -1 embperl/eg/web/config.pl
Index: config.pl
===================================================================
RCS file: /home/cvs/embperl/eg/web/config.pl,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- config.pl 27 Feb 2005 22:38:35 -0000 1.10
+++ config.pl 7 Aug 2005 15:59:09 -0000 1.11
@@ -38,7 +38,7 @@
$self -> {lib_1_3} ||= '' ;
# check if DBIx::Recordset is installed
- my $lib_dbix = $lib_1_3 ;
+ my $lib_dbix = $self -> {lib_1_3} ;
if (-e ($lib_dbix . '/DBIx/Intrors.pod'))
{
$self -> {lib_dbix} = $lib_dbix ;
1.9 +1 -1 embperl/eg/web/epwebapp.pl
Index: epwebapp.pl
===================================================================
RCS file: /home/cvs/embperl/eg/web/epwebapp.pl,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- epwebapp.pl 14 Feb 2005 18:45:54 -0000 1.8
+++ epwebapp.pl 7 Aug 2005 15:59:09 -0000 1.9
@@ -225,7 +225,7 @@
# map the request uri to the real filename
- my $uri = join ('/', @uri) ;
+ $uri = join ('/', @uri) ;
$pf = map_file ($r, $uri) ;
# try different location to statisfy links in pod via xslt
1.8 +4 -0 embperl/eg/web/messages.pl
Index: messages.pl
===================================================================
RCS file: /home/cvs/embperl/eg/web/messages.pl,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- messages.pl 9 Jan 2003 05:59:01 -0000 1.7
+++ messages.pl 7 Aug 2005 15:59:09 -0000 1.8
@@ -53,6 +53,7 @@
'cookie_note' => 'HINWEIS: Zur Anmeldung ist es erforderlich das Ihr Browser Cookies akzeptiert',
'user_email' => 'E-Mail Adresse',
'user_password' => 'Kennwort',
+ 'user_name' => 'Name',
'login' => 'Anmelden',
'logout' => 'Abmelden',
'newuser' => 'Neuen Benutzer-Account einrichten',
@@ -91,6 +92,7 @@
'err_cannot_delete_maybe_wrong_user_or_no_such_item' => 'L�schen fehlgeschlagen: Berechtigung fehlt',
'err_cannot_delete_db_error' => 'L�schen fehlgeschlagen: Datenbankfehler',
'err_item_not_found_or_access_denied' => 'Eintrag nicht gefunden oder Zugriff verweigert',
+ 'err_item_admin_mail' => 'Fehler beim Mailversand',
# Warnings
'warn_url_removed_white_space' => 'Leerzeichen wurden aus URL entfernt',
@@ -157,6 +159,7 @@
'cookie_note' => 'NOTE: For login it\'s necessary that your browser accepts cookies',
'user_email' => 'E-Mail address',
'user_password' => 'Password',
+ 'user_name' => 'Name',
'login' => 'Login',
'logout' => 'Logout',
'newuser' => 'Create new account',
@@ -195,6 +198,7 @@
'err_cannot_delete_maybe_wrong_user_or_no_such_item' => 'Deletion failed: Permission denied',
'err_cannot_delete_db_error' => 'Deletion failed: Database error',
'err_item_not_found_or_access_denied' => 'Item not found or access denied',
+ 'err_item_admin_mail' => 'Error sending mail',
# Warnings
'warn_url_removed_white_space' => 'Removed whitespaces from URL.',
1.7 +95 -26 embperl/eg/web/db/add.epl
Index: add.epl
===================================================================
RCS file: /home/cvs/embperl/eg/web/db/add.epl,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- add.epl 16 Jan 2003 07:14:35 -0000 1.6
+++ add.epl 7 Aug 2005 15:59:09 -0000 1.7
@@ -1,26 +1,55 @@
-[-
+[-
use File::Basename ;
use Data::Dumper ;
$DBIx::Recordset::Debug = 3;
-$maxrow = 3;
+$maxrow = 30 ;
$r = shift ;
+ $ct = $r->{category_texts};
+ $cy = $r->{category_types};
+ $cf = $r->{category_fields};
+ $cr = $r->{category_remarks};
+ $cfnl = $r->{category_fields_nolang};
+
+ @langs = ([{'id' => ''}, $cfnl]) ;
+ while ($rec = ${$r -> {language_set}} -> Next)
+ {
+ push @langs, [$rec, $cf] ;
+ }
+
-]
+
+<script>
+ [+ do { local $escmode = 0 ; $r -> {validate} -> get_script_code } +]
+</script>
+
+
+
+[$ if $r -> {category_set}{headline} !~ /^\s+$/$]
<table width="100%">
<tr bgcolor="#fefcad">
- <td><font size="4">[$ if $r -> {edit} $][= edit1 =] [$ else $][= add1 =] [$ endif $] [+ $r -> {category_set}{category} +]</font></td>
+ <td><font size="4">
+ [$if $r -> {category_set}{headline} $]
+ [+ $r -> {category_set}{headline} +]
+ [$else$]
+ [$ if $r -> {edit} $][= edit1 =] [$ else $][= add1 =] [$ endif $] [+ $r -> {category_set}{category} +]
+ [$endif$]
+ </font></td>
</tr>
</table>
-
+[$endif$]
[$ if !$r->{error} $]
-<form action="[+ $r -> app -> posturl('show.epl') +]" method="POST">
+<form action="[+ $r -> app -> posturl('show.epl') +]" method="POST"
+ name="form" onSubmit="return epform_validate_form()">
+[$if $cf && @$cf $]
[= add2a =]<br>
[= add2b =]<br><br>
+[$endif$]
[$ if $r -> {category_set}{add_info}$]
<B>[+ $r -> {category_set}{add_info} +]</b><br><br>
[$ endif $]
@@ -30,6 +59,8 @@
<table>
<tr>
<td class="cText" rowspan="2" valign="top">[= state =]: </td><td class="cInput"><input type="radio" name="state" value="1"[$ if ($r->{item_set}{state}) $] CHECKED[$ endif $]>[= display =]</td>
+ <td class="cText" rowspan="2" valign="top">[= modtime =]: </td>
+ <td class="cInput" rowspan="2"><input type="input" name="modtime" value="[+ $r -> {edit}?$r -> {item_set}{modtime}:'' +]"></td>
</tr>
<tr>
<td class="cInput"><input type="radio" name="state" value="0"[$ if !$r->{item_set}{state} $] CHECKED[$ endif $]>[= hide =]</td>
@@ -37,52 +68,84 @@
</table>
[$endif$]
-[-
- $ct = $r->{category_texts};
- $cy = $r->{category_types};
- $cf = $r->{category_fields};
-
-
--]
-
<table width="100%">
- [$while $rec = ${$r -> {language_set}} -> Next $]
+ [$foreach $lang (@langs) $]
+ [-
+ $rec = $lang -> [0] ;
+ $cf = $lang -> [1] ;
+ $postfix = $rec -> {id}?"_$rec->{id}":'' ;
+ -]
+ [$if $cf && @$cf $]
<tr bgcolor="#fefcad"><font size="3">
<td><font size=3><b>[+ $rec -> {name} +]</b></font></td>
</tr>
<tr>
<td>
[$ syntax EmbperlBlocks $]
- <table>
+ <table width="100%">
[$ foreach $type (@$cf) $]
- [$ if $txt = $ct->{$type . '_text'} $]
+ [$ if ($txt = $ct->{$type . '_text'}) && ($cy->{$type} !~ /^show/) $]
<tr>
[$ syntax Embperl $]
- [# <td class="cText" valign="top" colspan="2">[+ $txt +] / [+ $type +] / [+ $i++ +]</td> #]
- [$ if $cy->{$type} =~ /textarea/ $]
+ [# <td class="cText" valign="top" colspan="3">[+ $txt +] / [+ $type +] / [+ $i++ +]</td> #]
+ [$ if $cy->{$type} =~ /static/ $]
+ <td valign="top" colspan="3">[+ $txt +] </td>
+ [$ elsif $cy->{$type} =~ /checkboxrow/ $]
<td class="cText" valign="top">[+ $txt +]: </td>
<td class="cInput">
- <textarea name="[+ $type +]_[+ $rec -> {id} +]" cols="60" rows="10">[+ $fdat{"${type}_$rec->{id}"} +]</textarea>
+ [-
+ if ($type =~ /^(.*?)_id$/) {
+ $table = $1 ;
+ } else {
+ $table = $type;
+ }
+ $table =~ s/^.*__// ;
+ $poss = $r->app->get_titles($r,$table);
+ -]
+
+ [# [+ $type +] / [+ $table +] / [+ $r->{category_title_type} +]<PRE>[+ Dumper $poss +]</PRE> #]
+
+ [- $i = 0; -]
+ [$ while ( $t = $poss->[$i++] ) $]
+ <input type="checkbox" name="[+ $table +]" value="[+ $t->{id} +]" >[+ $t->{title} +]</input>
+ [$ endwhile $]
+ </td>
+ [$ elsif $cy->{$type} =~ /checkbox/ $]
+ <td class="cText" valign="top">[+ $txt +]: </td>
+ <td class="cInput">
+ <input type="checkbox" name="[+ "$type$postfix" +]" value="1">
+ </td>
+ [$ elsif $cy->{$type} =~ /textarea/ $]
+ <td class="cText" valign="top">[+ $txt +]: </td>
+ <td class="cInput">
+ <textarea name="[+ "$type$postfix" +]" style="width: 100%" cols="60" rows="10"></textarea>
</td>
[$ elsif $cy->{$type} =~ /pulldown/ $]
<td class="cText" valign="top">[+ $txt +]: </td>
<td class="cInput">
[-
- ($table = $type) =~ s/_id$//;
+ $type =~ /^(.*?)_id$/;
+ $table = $1 ;
+ $table ||= $type;
+ $table =~ s/^.*__// ;
$poss = $r->app->get_titles($r,$table);
- -]
-
+
+ -]
+
[# [+ $type +] / [+ $table +] / [+ $r->{category_title_type} +]<PRE>[+ Dumper $poss +]</PRE> #]
- <select name="[+ $type +]_[+ $rec -> {id} +]">
+ <select name="[+ "$type$postfix" +]">
[- $item = $poss->[$row] -]
<option value="[+ $item->{id} +]">[+ $item->{title} +]</option>
</select>
</td>
[$ else $]
<td class="cText" valign="top">[+ $txt +]: </td>
- <td class="cInput"><input type="text" name="[+ $type +]_[+ $rec -> {id} +]" size="80"> </td>
+ <td class="cInput"><input type="text" size="60" name="[+ "$type$postfix" +]" size="80"> </td>
[$ endif $]
+ <td valign="top" align="right">
+ [+ $cr->{$type} +]
+ </td>
[$ syntax EmbperlBlocks $]
</tr>
[$ endif $]
@@ -92,22 +155,28 @@
<input type="hidden" name="id_[+ $rec -> {id} +]">
</td>
</tr>
- [$endwhile$]
+ [$endif$]
+ [$endforeach$]
</table>
+[$ if $r -> {edit} $]
<br>Owner: [+ $r->{item_set}{email} +]
+[$endif$]
<br><br>
[$ if $r -> {edit} $]
<input type="submit" name="-update_item" value="[= update3 =]">
<input type="submit" name="-delete_item" value="[= delete3 =]">
[$ else $]
- <input type="submit" name="-add_item" value="[= add3 =] [+ $r -> {category_set}{category} +]">
+ <input type="submit" name="-add_item" value="[$
+if $r -> {category_set}{sendtext} $][+ $r -> {category_set}{sendtext} +][$else$]
+[= add3 =] [+ $r -> {category_set}{category} +][$endif$]">
[$endif$]
<input type="hidden" name="category_id">
<input type="hidden" name="[+ $r -> {category_set}{table_type} +]_id">
+<input type="hidden" name="-logintext" value="[+ $r -> {category_set}{logintext} +]">
</form>
[$ endif $]
1.6 +6 -2 embperl/eg/web/db/addsel.epl
Index: addsel.epl
===================================================================
RCS file: /home/cvs/embperl/eg/web/db/addsel.epl,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- addsel.epl 16 Jan 2003 07:14:35 -0000 1.5
+++ addsel.epl 7 Aug 2005 15:59:09 -0000 1.6
@@ -40,10 +40,12 @@
<p class="cHeadline">[= addsel1 =]</p>
<ul>
+ [- $rec = $r -> {category_set}[$row] ; -]
+ [$ if ($rec -> {edit_level} <= ($r -> {user_admin}?2:1)) $]
<li>
- [- $rec = $r -> {category_set}[$row] -]
<a href="add.-category_id-[+ $rec -> {category_id} +]-.epl">[+ $rec -> {category} +]</a>
</li>
+ [$endif$]
</ul>
@@ -52,10 +54,12 @@
<p class="cHeadline">[= addsel_upd =]</p>
<ul>
+ [- $rec = $r -> {category_set}[$row] ;-]
+ [$if ($rec -> {edit_level} <= ($r -> {user_admin}?2:1)) $]
<li>
- [- $rec = $r -> {category_set}[$row] -]
<a href="list.-category_id-[+ $rec -> {category_id} +]-.epl">[+ $rec -> {category} +]</a>
</li>
+ [$endif$]
</ul>
[$else$]
1.7 +5 -2 embperl/eg/web/db/content.epl
Index: content.epl
===================================================================
RCS file: /home/cvs/embperl/eg/web/db/content.epl,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- content.epl 16 Jan 2003 07:14:35 -0000 1.6
+++ content.epl 7 Aug 2005 15:59:09 -0000 1.7
@@ -2,7 +2,6 @@
<hr>
<center><font color="red" size=3>[= under_construction =]</font><br></center>
#]
-<hr>
[! use File::Basename ; !]
[- $r = shift -]
@@ -42,7 +41,11 @@
[$ if $r -> {need_login} $]
<div align="center">
- <p>[= need_login =]</p>
+ [$ if $fdat{-logintext} $]
+ <p>[+ $fdat{-logintext} +]</p>
+ [$else$]
+ <p>[= need_login =]</p>
+ [$endif$]
[- Execute ('loginform.epl', $r -> app -> posturl) ; -]
</div>
1.13 +263 -142 embperl/eg/web/db/epwebapp.pl
Index: epwebapp.pl
===================================================================
RCS file: /home/cvs/embperl/eg/web/db/epwebapp.pl,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- epwebapp.pl 27 Feb 2003 07:05:33 -0000 1.12
+++ epwebapp.pl 7 Aug 2005 15:59:09 -0000 1.13
@@ -4,11 +4,12 @@
use Data::Dumper ;
use Embperl::Mail ;
use File::Basename ;
+use Embperl::Form::Validate;
BEGIN { Execute ({isa => '../epwebapp.pl', syntax => 'Perl'}) ; }
-sub init
+sub init
{
my $self = shift ;
my $r = shift ;
@@ -26,41 +27,49 @@
$r->{warning} = [];
- $self -> checkuser ($r) ;
- $r -> {language_set} = DBIx::Recordset -> Search ({'!DataSource' => $db,
+ my $login = $self -> checkuser ($r) ;
+ if ($config->{always_need_login} && $login < 1)
+ {
+ $r -> {need_login} = 1 ;
+ return ;
+ }
+ return 0 if ($r->{done}) ;
+
+ # warn "fdat = ", Data::Dumper->Dump ([\%fdat]);
+
+ $r -> {language_set} = DBIx::Recordset -> Search ({'!DataSource' => $db,
'!Table' => 'language'}) ;
-
if ($fdat{-add_category})
{
$self -> add_category($r) ;
- $self -> get_category($r) ;
+ $self -> get_category($r, 2) ;
}
elsif ($fdat{-add_item})
{
- $self -> get_category($r) ;
+ $self -> get_category($r, 2) ;
$ret = $self -> add_item($r) ;
}
elsif ($fdat{-update_item})
{
- $self -> get_category($r) ;
+ $self -> get_category($r, 2) ;
$ret = $self -> update_item ($r) ;
}
elsif ($fdat{-delete_item})
{
- $self -> get_category($r) ;
+ $self -> get_category($r, 2) ;
$ret = $self -> delete_item($r) ;
}
elsif ($fdat{-edit_item})
{
- $self -> get_category($r) ;
+ $self -> get_category($r, 2) ;
$self -> get_item_lang($r) ;
$self -> setup_edit_item($r) ;
}
elsif ($fdat{-show_item})
{
- $self -> get_category($r) ;
+ $self -> get_category($r, 2) ;
$self -> get_item_lang($r) ;
}
elsif ($fdat{-update_user})
@@ -92,29 +101,25 @@
my $r = shift ;
my $config = $r -> {config} ;
- $DBIx::Recordset::Debug = 1 ;
- #*DBIx::Recordset::LOG = \*STDERR ;
+ $DBIx::Recordset::Debug = $config -> {dbdebug} || 1 ;
+ *DBIx::Recordset::LOG = \*STDERR ;
my $db = DBIx::Database -> new ({'!DataSource' => $config -> {dbdsn},
'!Username' => $config -> {dbuser},
'!Password' => $config -> {dbpassword},
'!DBIAttr' => { RaiseError => 1, PrintError => 1, LongReadLen => 32765, LongTruncOk => 0, },
-
+
}) ;
$db -> TableAttr ('*', '!SeqClass', "DBIx::Recordset::FileSeq,$config->{root}/db") if ($^O eq 'MSWin32') ;
- $db -> TableAttr ('*', '!Filter',
+ $db -> TableAttr ('*', '!PrimKey', 'id') ;
+ $db -> TableAttr ('*', '!Filter',
{
'creationtime' => [\¤t_time, undef, DBIx::Recordset::rqINSERT ],
'modtime' => [\¤t_time, undef, DBIx::Recordset::rqINSERT + DBIx::Recordset::rqUPDATE ],
}) ;
$r -> {db} = $db ;
-
- if ($config->{always_need_login} && ($self -> checkuser($r) < 1))
- {
- $r -> {need_login} = 1 ;
- return ;
- }
+
}
# ----------------------------------------------------------------------------
@@ -200,6 +205,7 @@
my $self = shift ;
my $r = shift ;
+
if ($udat{user_id} && $udat{user_email} && !$fdat{-logout})
{
$r -> {user_id} = $udat{user_id} ;
@@ -208,7 +214,7 @@
return $r -> {user_admin}?2:1 ;
}
- if (($fdat{-login} || $fdat{-newuser} || $fdat{-newpassword})
+ if (($fdat{-login} || $fdat{-newuser} || $fdat{-newpassword})
&& !$fdat{user_email})
{
$r -> {error} = 'err_email_needed' ;
@@ -219,8 +225,8 @@
if ($fdat{user_email})
{
- $user = DBIx::Recordset -> Search ({'!DataSource' => $r -> {db},
- '!Table' => 'user',
+ $user = DBIx::Recordset -> Search ({'!DataSource' => $r -> {db},
+ '!Table' => 'user',
'email' => $fdat{user_email}}) ;
}
@@ -234,8 +240,9 @@
$r -> {success} = "suc_login";
return $r -> {user_admin}?2:1 ;
}
-
+
$r -> {error} = 'err_access_denied' ;
+ $r -> {need_login} = 1 ;
return ;
}
@@ -247,7 +254,7 @@
$r -> {success} = 'suc_logout';
return ;
}
-
+
if ($fdat{-newuser} && $user -> {id})
{
$r -> {error} = 'err_user_exists';
@@ -275,8 +282,9 @@
{
my @errors_user = ();
my @errors_admin = ();
- my $set = DBIx::Recordset -> Insert ({'!DataSource' => $r -> {db},
- '!Table' => 'user',
+ my $set = DBIx::Recordset -> Insert ({'!DataSource' => $r -> {db},
+ '!Table' => 'user',
+ 'user_name' => $fdat{user_name},
'password' => $user_password,
'email' => $fdat{user_email}}) ;
if (DBIx::Recordset -> LastError)
@@ -286,13 +294,13 @@
}
my $usermail = Embperl::Mail::Execute ({
- inputfile => 'newuser.mail',
+ inputfile => 'newuser.mail',
from => $r->{config}->{emailfrom},
- to => $fdat{user_email},
+ to => $fdat{user_email},
subject => $r->gettext('mail_subj_newuser'),
param => [$user_password],
errors => \@errors_user});
- if ($usermail)
+ if ($usermail)
{
$r->{error} = 'err_user_mail';
$r->{error_details} = join("\n",@errors_user);
@@ -300,15 +308,15 @@
else
{
$r->{success} = 'suc_password_sent';
- }
+ }
my $adminmail = Embperl::Mail::Execute ({
- inputfile => 'newuser.admin.mail',
+ inputfile => 'newuser.admin.mail',
from => $r->{config}->{emailfrom},
to => $r->{config}->{adminemail},
- subject => ($r->{error} ?
- "Error while creating new Embperl website user '$fdat{user_email}'" :
- "New Embperl website user: $fdat{user_email}"),
+ subject => ($r->{error} ?
+ "Error while creating new website user '$fdat{user_email}'" :
+ "New website user: $fdat{user_email}"),
errors => \@errors_admin});
if ($adminmail)
@@ -317,26 +325,29 @@
$r->{error_details} = join('; ',@errors_admin);
}
+ $r -> {done} = 1 ;
+ $r -> {need_login} = 1 ;
+
return ;
}
if ($fdat{-newpassword} && $fdat{user_email})
{
my @errors_pw;
- my $set = DBIx::Recordset -> Update ({'!DataSource' => $r -> {db},
- '!Table' => 'user',
+ my $set = DBIx::Recordset -> Update ({'!DataSource' => $r -> {db},
+ '!Table' => 'user',
'password' => $user_password,
'email' => $fdat{user_email}},
{'id' => $user -> {id}}) ;
my $newpw_mail = Embperl::Mail::Execute ({
- inputfile => 'newpw.mail',
+ inputfile => 'newpw.mail',
from => $r->{config}->{emailfrom},
- to => $fdat{user_email},
+ to => $fdat{user_email},
subject => $r->gettext('mail_subj_newpw'),
param => [$user_password],
errors => \@errors_pw});
- if ($newpw_mail)
+ if ($newpw_mail)
{
$r->{error} .= 'err_pw_mail';
$r->{error_details} .= join("\n",@errors_pw);
@@ -345,10 +356,12 @@
{
$r->{success} = 'suc_password_sent';
}
+ $r -> {need_login} = 1 ;
+ $r -> {done} = 1 ;
return ;
}
-
+
return ;
}
@@ -368,16 +381,16 @@
$r -> {need_login} = 1 ;
return ;
}
-
- my $set = DBIx::Recordset -> Insert ({'!DataSource' => $r -> {db},
+
+ my $set = DBIx::Recordset -> Insert ({'!DataSource' => $r -> {db},
'!Table' => 'category',
'!Serial' => 'id',
state => 0}) ;
my $id = $$set -> LastSerial ;
my $langset = $r -> {language_set} ;
- my $txtset = DBIx::Recordset -> Setup ({'!DataSource' => $r -> {db},
+ my $txtset = DBIx::Recordset -> Setup ({'!DataSource' => $r -> {db},
'!Table' => 'categorytext'}) ;
-
+
$$langset -> Reset ;
while ($rec = $$langset -> Next)
{
@@ -396,6 +409,8 @@
my $self = shift ;
my $r = shift ;
+ die "No category" if (!defined ($r->{category_set}{edit_level})) ;
+
if ($self -> checkuser($r) < $r->{category_set}{edit_level})
{
$r -> {need_login} = 1 ;
@@ -406,11 +421,12 @@
my $tt = $r->{category_set}{table_type};
my $cf = $r->{category_fields};
+ my $cfnl = $r->{category_fields_nolang};
- foreach (@$cf)
+ foreach ((@$cf, @$cfnl))
{
next unless $r->{category_types}{$_} =~ /url/;
-
+
if ($fdat{$_} && $fdat{$_} =~ /\s/)
{
$fdat{$_} =~ s/\s//g;
@@ -425,9 +441,10 @@
}
- my $set = DBIx::Recordset -> Insert ({'!DataSource' => $r -> {db},
+ my $set = DBIx::Recordset -> Insert ({'!DataSource' => $r -> {db},
'!Table' => $tt,
'!Serial' => 'id',
+ (map { $_ => $fdat{$_} } @$cfnl),
url => $fdat{url},
$fdat{modtime} ? (modtime => $fdat{modtime}) : (),
category_id => $fdat{category_id},
@@ -436,32 +453,32 @@
my $id = $$set -> LastSerial ;
my $langset = $r -> {language_set} ;
- my $txtset = DBIx::Recordset -> Setup ({'!DataSource' => $r -> {db},
+ my $txtset = DBIx::Recordset -> Setup ({'!DataSource' => $r -> {db},
'!Table' => "${tt}text"}) ;
-
+
$$langset -> Reset ;
while ($rec = $$langset -> Next)
{
# Check the URL
-
+
my $lang = $rec->{id};
foreach (@$cf)
{
next unless $r->{category_types}{$_.'_'.$lang} =~ /url/;
-
+
if ($fdat{$_.'_'.$lang} && $fdat{$_.'_'.$lang} =~ /\s/)
{
$fdat{$_.'_'.$lang} =~ s/\s//g;
push(@{$r->{warning}}, 'warn_url_removed_white_space');
}
-
+
if ($fdat{$_.'_'.$lang} && $fdat{$_.'_'.$lang} !~ m{http://})
{
$fdat{$_.'_'.$lang} =~ s{^}{http://};
push(@{$r->{warning}}, 'warn_url_added_http');
}
-
+
}
$$txtset -> Insert ({ (map { $_ => $fdat{$_.'_'.$lang} || $fdat{$_} } @$cf),
@@ -475,11 +492,11 @@
$r->{item_set} = undef ;
$self->get_item_lang($r);
- if (!$udat{user_admin})
+ if (!$udat{user_admin})
{
my @errors;
my $newitemmail = Embperl::Mail::Execute ({
- inputfile => 'updateditem.mail',
+ inputfile => 'updateditem.mail',
from => $r->{config}->{emailfrom},
to => $r->{config}->{adminemail},
subject => 'New item on Embperl Website (Category '.$r->{category_set}{category}.')'.($udat{user_email}?" by $udat{user_email}":''),
@@ -488,7 +505,7 @@
{
$r->{error} = 'err_item_admin_mail';
$r->{error_details} = join("\n",@errors);
-
+
return;
}
}
@@ -505,6 +522,8 @@
my $self = shift ;
my $r = shift ;
+ die "No category" if (!defined ($r->{category_set}{edit_level})) ;
+
if ($self -> checkuser($r) < $r->{category_set}{edit_level})
{
$r -> {need_login} = 1 ;
@@ -513,6 +532,7 @@
my $tt = $r->{category_set}{table_type};
my $cf = $r->{category_fields};
+ my $cfnl = $r->{category_fields_nolang};
# make sure we have an id
if (!$fdat{"${tt}_id"})
@@ -521,31 +541,35 @@
return ;
}
- my $set = DBIx::Recordset -> Setup ({'!DataSource' => $r -> {db},
+ my $set = DBIx::Recordset -> Setup ({'!DataSource' => $r -> {db},
'!Table' => $tt }) ;
# update the entry, but only if it has the correct user id or the has admin rights
- my $rows = $$set -> Update ({ url => $fdat{url},
- $fdat{modtime} ? (modtime => $fdat{modtime}) : (),
- $fdat{category_id} ? (category_id => $fdat{category_id}) : (),
- $r->{user_admin} ? (state => $fdat{state}) : () },
- { id => $fdat{"${tt}_id"},
+ my $rows = $$set -> Select ({ id => $fdat{"${tt}_id"},
$r ->{user_admin} ? () : (user_id => $r->{user_id}) }) ;
-
if ($rows <= 0)
{ # error if nothing was found (this will happen when the record isdn't owned by the user)
- $r -> {error} = 'err_cannot_update_maybe_wrong_user' ;
+ $r -> {error} = 'err_cannot_update_maybe_wrong_user' ;
return ;
}
+ $$set -> Update ({ url => $fdat{url},
+ (map { $_ => $fdat{$_} } @$cfnl),
+ $fdat{modtime} ? (modtime => $fdat{modtime}) : (),
+ $fdat{category_id} ? (category_id => $fdat{category_id}) : (),
+ $r->{user_admin} ? (state => $fdat{state}) : () },
+ { id => $fdat{"${tt}_id"},
+ $r ->{user_admin} ? () : (user_id => $r->{user_id}) }) ;
+
+
my $id = $fdat{"${tt}_id"} ;
my $langset = $r -> {language_set} ;
- my $txtset = DBIx::Recordset -> Setup ({'!DataSource' => $r -> {db},
+ my $txtset = DBIx::Recordset -> Setup ({'!DataSource' => $r -> {db},
'!Table' => "${tt}text"}) ;
if (DBIx::Recordset->LastError)
{
- $r -> {error} = 'err_update_db' ;
+ $r -> {error} = 'err_update_db' ;
return ;
}
@@ -558,28 +582,36 @@
my $lang = $rec->{id};
if (grep { $fdat{$_.'_'.$lang} || $fdat{$_} } @$cf)
{
- $rows = $$txtset -> Update ({ (map { $_ => $fdat{$_.'_'.$lang} || $fdat{$_} } @$cf),
- language_id => $lang,
- }, {
- "${tt}_id" => $id,
- id => $fdat{"id_$lang"}
- }) ;
-
+ $rows = $$txtset -> Select ("${tt}_id" => $id) ;
if (DBIx::Recordset->LastError)
{
- $r -> {error} = 'err_update_lang_db' ;
+ $r -> {error} = 'err_update_lang_db' ;
return ;
}
elsif ($rows == 0)
{
$$txtset -> Insert ({ (map { $_ => $fdat{$_.'_'.$lang} || $fdat{$_} } @$cf),
language_id => $lang,
- "${tt}_id" => $id,
+ "${tt}_id" => $id,
}) ;
if (DBIx::Recordset->LastError)
{
- $r -> {error} = 'err_update_lang_db' ;
+ $r -> {error} = 'err_update_lang_db' ;
+ return ;
+ }
+ }
+ else
+ {
+ $rows = $$txtset -> Update ({ (map { $_ => $fdat{$_.'_'.$lang} || $fdat{$_} } @$cf),
+ language_id => $lang,
+ }, {
+ "${tt}_id" => $id,
+ id => $fdat{"id_$lang"}
+ }) ;
+ if (DBIx::Recordset->LastError)
+ {
+ $r -> {error} = 'err_update_lang_db' ;
return ;
}
}
@@ -589,12 +621,12 @@
$r -> {item_set} = undef ;
$self->get_item_lang($r) ;
- if (!$udat{user_admin})
+ if (!$udat{user_admin})
{
my @errors;
$r->{is_update} = 1;
my $newitemmail = Embperl::Mail::Execute ({
- inputfile => 'updateditem.mail',
+ inputfile => 'updateditem.mail',
from => $r->{config}->{emailfrom},
to => $r->{config}->{adminemail},
subject => 'Updated item on Embperl Website (Category '.$r->{category_set}{category}.')'.($udat{user_email}?" by $udat{user_email}":''),
@@ -603,7 +635,7 @@
{
$r->{error} = 'err_item_admin_mail';
$r->{error_details} = join('; ',@errors);
-
+
return;
}
}
@@ -633,19 +665,19 @@
# make sure we have an id
if (!$fdat{"${tt}_id"})
{
- $r -> {error} = 'err_cannot_delete_no_id' ;
+ $r -> {error} = 'err_cannot_delete_no_id' ;
return ;
}
# first see if the entry exists and has the correct user_id
- my $set = DBIx::Recordset -> Search ({'!DataSource' => $r->{db},
+ my $set = DBIx::Recordset -> Search ({'!DataSource' => $r->{db},
'!Table' => $tt,
id => $fdat{"${tt}_id"},
$r->{user_admin} ? () : (user_id => $r->{user_id}) }) ;
if (!$$set -> MoreRecords())
{ # error if nothing was found (this will happen when the record isdn't owned by the user
- $r -> {error} = 'err_cannot_delete_maybe_wrong_user_or_no_such_item' ;
+ $r -> {error} = 'err_cannot_delete_maybe_wrong_user_or_no_such_item' ;
return ;
}
@@ -662,16 +694,16 @@
my $id = $fdat{"${tt}_id"} ;
my $langset = $r -> {language_set} ;
- my $txtset = DBIx::Recordset -> Setup ({'!DataSource' => $r -> {db},
+ my $txtset = DBIx::Recordset -> Setup ({'!DataSource' => $r -> {db},
'!Table' => "${tt}text"}) ;
-
+
# Delete the texts for every languange, but only if they belong to the item we have delete above
$$langset -> Reset ;
while ($rec = $$langset -> Next)
{
- $$txtset -> Delete ({ "${tt}_id" => $id,
+ $$txtset -> Delete ({ "${tt}_id" => $id,
id => $fdat{"id_$rec->{id}"}}) ;
-
+
if (DBIx::Recordset->LastError)
{
$r->{error} = 'err_cannot_delete_db_error';
@@ -680,12 +712,12 @@
}
}
- if (!$udat{user_admin})
+ if (!$udat{user_admin})
{
my @errors;
$r->{is_update} = -1;
my $newitemmail = Embperl::Mail::Execute ({
- inputfile => 'updateditem.mail',
+ inputfile => 'updateditem.mail',
from => $r->{config}->{emailfrom},
to => $r->{config}->{adminemail},
subject => 'Delete item on Embperl Website (Category '.$r->{category_set}{category}.')'.($udat{user_email}?" by $udat{user_email}":''),
@@ -694,7 +726,7 @@
{
$r->{error} = 'err_item_admin_mail';
$r->{error_details} = join('; ',@errors);
-
+
return;
}
}
@@ -707,11 +739,11 @@
# ----------------------------------------------------------------------------
-sub redir_to_show
+sub redir_to_show
{
my $self = shift ;
my $r = shift ;
-
+
my $tt = $r->{category_set}{table_type};
my %params =
@@ -726,9 +758,10 @@
my $dest = join ('&', map { $_ . '=' . $r -> Escape (ref ($params{$_})?join("\t", @{$params{$_}}):$params{$_} , 2) } keys %params) ;
#$http_headers_out{'location'} = "show.epl?$dest";
- Apache -> request -> err_header_out('location', $r -> param -> server_addr . dirname ($r -> param -> uri) ."/show.epl?$dest") ;
+ my ($uri) = split (/\?/, $r -> param -> unparsed_uri, 1) ;
+ Apache -> request -> err_header_out('location', $r -> param -> server_addr . dirname ($uri) ."/show.epl?$dest") ;
#Apache -> request -> err_header_out('location', 'http://www.ecos.de:8766' . dirname ($r -> param -> uri) ."/show.epl?$dest") ;
-
+
return 302 ;
}
@@ -741,39 +774,65 @@
{
my $self = shift ;
my $r = shift ;
+ my $edit = shift || 0 ;
- $r -> {category_set} = DBIx::Recordset -> Search ({'!DataSource' => $r -> {db},
- '!Table' => 'category, categorytext',
+ $r -> {category_set} = DBIx::Recordset -> Search ({'!DataSource' => $r -> {db},
+ '!Table' => 'category, categorytext',
'!TabRelation' => 'category_id = category.id',
'language_id' => $r -> param -> language,
$fdat{category_id}?(category_id => $fdat{category_id}):(),
- $r -> {user_admin}?():(state => 1)}) ;
+ $edit?(edit_level => $r -> {user_admin}?2:1, '*edit_level' => '<='):(),
+ $r -> {user_admin} || $edit?():(state => 1)}) ;
+
+ my $level = $r -> {user_admin}?2:1 ;
+ my $level_field = $edit?'categoryfields.edit_level':'categoryfields.view_level' ;
+
- *fields = DBIx::Recordset -> Search ({'!DataSource' => $r -> {db},
- '!Table' => 'category, categoryfields',
+ *fields = DBIx::Recordset -> Search ({'!DataSource' => $r -> {db},
+ '!Table' => 'category, categoryfields',
'!TabRelation' => 'category_id = category.id',
'language_id' => $r -> param -> language,
$fdat{category_id}?(category_id => $fdat{category_id}):(),
- $r -> {user_admin}?():(state => 1),
+ $edit?('category.edit_level' => $r -> {user_admin}?2:1, '*category.edit_level' => '<='):(),
+ $level_field => $level,
+ "*$level_field" => '<=',
+ $r -> {user_admin} || $edit?():(state => 1),
'$order' => 'position' }) ;
my %texts = ();
my %types = ();
-# my %position = ();
+ my %remarks = ();
my @textfields = ();
+ my @textfields_nolang = ();
+ my @validate ;
while (my $field = $fields->Next)
- {
- push(@textfields, $field->{fieldname});
+ {
+ if ($field->{nolang})
+ {
+ push(@textfields_nolang, $field->{fieldname});
+ }
+ else
+ {
+ push(@textfields, $field->{fieldname});
+ }
$texts{$field->{fieldname}.'_text'} = $field->{txt};
$types{$field->{fieldname}} = $field->{typeinfo};
-# $position{$field->{fieldname}} = $field->{position};
- }
+ $remarks{$field->{fieldname}} = $field->{remark};
+ if ($field -> {validate})
+ {
+ my @tests = split (/[=,]/, $field -> {validate}) ;
+ push @validate, ('-key', $field->{fieldname}) ;
+ push @validate, ('-name', $field->{txt}) ;
+ push @validate, @tests ;
+ }
+ }
$r -> {category_fields} = \@textfields;
+ $r -> {category_fields_nolang} = \@textfields_nolang;
$r -> {category_texts} = \%texts;
$r -> {category_types} = \%types;
-# $r -> {category_position} = \%position;
+ $r -> {category_remarks} = \%remarks;
my $title_type = 'heading';
foreach my $f (@textfields)
@@ -787,6 +846,9 @@
$r -> {category_title_type} = $title_type;
+
+ $r -> {validate} = new Embperl::Form::Validate(\@validate, 'form') ;
+
}
@@ -810,16 +872,64 @@
}
}
- $tt = $r->{category_set}{table_type};
+ my $tt = $r->{category_set}{table_type};
- $r -> {item_set} = DBIx::Recordset -> Search ({'!DataSource' => $r->{db},
- '!Table' => "user, ${tt}, ${tt}text",
- '!TabRelation' => "${tt}_id = ${tt}.id and ${tt}.user_id = user.id",
- 'language_id' => $r->param->language,
- '!Order' => 'modtime desc',
+
+ my $currlang = $r->param->language ;
+ my $rec ;
+ my %idmap ;
+ my @langs ;
+ while ($rec = ${$r -> {language_set}} -> Next)
+ {
+ push @langs, $rec->{id} ;
+ }
+
+
+ ${$r -> {language_set}} -> Reset ;
+ @langs = grep {$_ ne $currlang} @langs ;
+ push @langs, $currlang ;
+
+
+ foreach my $lang (@langs)
+ {
+ my $set = DBIx::Recordset -> Search ({'!DataSource' => $r->{db},
+ '!Fields' => "$tt.id as id, ${tt}text.id as textid",
+ '!Table' => "user, ${tt}, ${tt}text",
+ '!TabJoin' => "($tt left join ${tt}text on (${tt}_id = ${tt}.id)), user",
+ '!TabRelation' => "${tt}.user_id = user.id",
+ '$expr1' => {
+ 'language_id' => $lang,
+ '$conj' => 'or',
+ "${tt}_id" => undef,
+ },
$fdat{category_id} ? (category_id => $fdat{category_id}) : (),
- $fdat{"${tt}_id"} ? ("${tt}_id" => $fdat{"${tt}_id"}) : (),
+ $fdat{"${tt}_id"} ? ("${tt}_id" => $fdat{"${tt}_id"}) : (),
%state}) ;
+ while ($rec = $$set -> Next)
+ {
+ $idmap{$rec -> {id}} = $rec -> {textid} ;
+ }
+ }
+
+ warn 'dbg ' . __LINE__ . "tab = user, ${tt}, ${tt}text; fields = *, $tt.id as ${tt}_id; idmap = " .
+ join (',', keys %idmap) if ($r -> {config}{dbdebug} > 1);
+ $r -> {item_set} = DBIx::Recordset -> Search ({'!DataSource' => $r->{db},
+ '!Fields' => "*, $tt.id as ${tt}_id",
+ '!Table' => "user, ${tt}, ${tt}text",
+ '!TabJoin' => "($tt left join ${tt}text on (${tt}text.${tt}_id = ${tt}.id)), user",
+ '!TabRelation' => "${tt}.user_id = user.id",
+ #"$tt.id" => [keys %idmap],
+ '$expr1' => {
+ '$expr1' => { "${tt}text.id" => [values %idmap], },
+ #'language_id' => $currlang,
+ '$conj' => 'or',
+ '$expr2' => { "${tt}text.id" => undef },
+ },
+ '!Order' => $fdat{-order} || 'modtime desc',
+ $fdat{category_id} ? (category_id => $fdat{category_id}) : (),
+ $fdat{"${tt}_id"} ? ("${tt}_id" => $fdat{"${tt}_id"}) : (),
+ %state}) ;
+
}
@@ -846,20 +956,21 @@
$tt = $r->{category_set}{table_type};
- $r -> {item_set} = DBIx::Recordset -> Search ({'!DataSource' => $r->{db},
- '!Table' => "user, ${tt}, language, ${tt}text", # ${tt}text must be last to get it's id
- '!TabRelation' => "${tt}_id = ${tt}.id and language_id = language.id and ${tt}.user_id = user.id",
+ $r -> {item_set} = DBIx::Recordset -> Search ({'!DataSource' => $r->{db},
+ '!Fields' => "*, ${tt}text.id as id, $tt.id as ${tt}_id",
+ '!Table' => "user, ${tt}, language, ${tt}text",
+ '!TabJoin' => "($tt left join ${tt}text on (${tt}_id = ${tt}.id)) left join language on (language_id = language.id), user",
+ '!TabRelation' => "${tt}.user_id = user.id",
'!Order' => 'modtime desc',
$fdat{category_id} ? (category_id => $fdat{category_id}) : (),
- $fdat{"${tt}_id"} ? ("${tt}_id" => $fdat{"${tt}_id"}) : (),
+ $fdat{"${tt}_id"} ? ("${tt}.id" => $fdat{"${tt}_id"}) : (),
%state}) ;
-
-# push(@{$r->{warning}}, 'get_item_lang =>', $tt, @{$r->{item_set}});
-# ${$r->{item_set}}->Reset;
+
+
$r->{item_set} = undef unless ${$r->{item_set}}->MoreRecords;
${$r->{item_set}} -> Reset if ($r->{item_set}) ;
-
+
}
# ----------------------------------------------------------------------------
@@ -886,9 +997,10 @@
my $tt = $r->{category_set}{table_type};
my $cf = $r->{category_fields};
+ my $cfnl = $r->{category_fields_nolang};
$fdat{"${tt}_id"} = $set->{"${tt}_id"} if $set->{"${tt}_id"};
-
+
$$set -> Reset ;
while ($rec = $$set -> Next)
{
@@ -898,8 +1010,12 @@
{
$fdat{$type . '_' . $lang} = $rec -> {$type} ;
}
+ foreach my $type (@$cfnl)
+ {
+ $fdat{$type} = $rec -> {$type} ;
+ }
}
-
+
$$set -> Reset ;
$r -> {edit} = 1 ;
}
@@ -914,7 +1030,7 @@
$fdat{user_id} = undef unless $r -> {user_admin};
- $r -> {user_set} = DBIx::Recordset -> Search ({'!DataSource' => $r->{db},
+ $r -> {user_set} = DBIx::Recordset -> Search ({'!DataSource' => $r->{db},
'!Table' => "user",
id => $fdat{user_id} || $udat{user_id}
}) ;
@@ -936,7 +1052,7 @@
return unless $r -> {user_admin};
- $r -> {users} = DBIx::Recordset -> Search ({'!DataSource' => $r->{db},
+ $r -> {users} = DBIx::Recordset -> Search ({'!DataSource' => $r->{db},
'!Table' => "user" }) ;
$r->{users} = undef unless ${$r->{users}}->MoreRecords;
}
@@ -961,9 +1077,9 @@
return;
}
- eval { *set = DBIx::Recordset -> Update ({'!DataSource' => $r->{db},
- '!Table' => "user",
- 'name' => $fdat{name},
+ eval { *set = DBIx::Recordset -> Update ({'!DataSource' => $r->{db},
+ '!Table' => "user",
+ 'user_name' => $fdat{user_name},
'pid' => $fdat{pid} },
{ id => $fdat{user_id} || $udat{user_id}}) ; };
@@ -973,7 +1089,7 @@
$r->{error} = 'err_pid_exists';
return;
}
-
+
if (DBIx::Recordset->LastError)
{
$r->{error} = 'err_update_db';
@@ -989,11 +1105,11 @@
# Warning: This will not yet work as intended if there is more than
# one category using $table as category type!
-sub get_title
+sub get_title
{
my ($self, $r, $col, $id) = @_;
- (my $table = $col) =~ s/_id$// or die "Can't strip '_id'";
+ (my $table = $col) =~ s/_id$// or die "Can't strip '_id' (col=$col)";
my $config = $r->{config};
my $db = DBIx::Database -> new ({'!DataSource' => $config -> {dbdsn},
@@ -1003,19 +1119,21 @@
# SQL can't handle such kind soft links, so we need two requests
- *fields = DBIx::Recordset -> Search ({'!DataSource' => $db,
- '!Table' => 'category, categoryfields',
+ *fields = DBIx::Recordset -> Search ({'!DataSource' => $db,
+ '!Table' => 'category, categoryfields',
+ '!TabRelation' => 'category_id = category.id',
'table_type' => $table,
- 'state' => 1,
+ #'state' => 1,
'typeinfo' => 'title',
'*typeinfo' => 'LIKE',
'$order' => 'position' }) ;
- *set = DBIx::Recordset -> Search ({'!DataSource' => $db,
+ *set = DBIx::Recordset -> Search ({'!DataSource' => $db,
'!Table' => $table.'text',
'language_id' => $r -> param -> language,
$table.'_id' => $id }) ;
+
return $set{$fields{fieldname}};
}
@@ -1027,7 +1145,7 @@
{
my ($self, $r, $table) = @_;
-# *set = DBIx::Recordset -> Search ({'!DataSource' => $r->{db},
+# *set = DBIx::Recordset -> Search ({'!DataSource' => $r->{db},
# '!Fields' => "id,$r->{category_title_type} as title",
# '!Table' => $table, }) ;
# print OUT Dumper $config;
@@ -1042,22 +1160,25 @@
}) ;
# SQL can't handle such kind soft links, so we need two requests
- *fields = DBIx::Recordset -> Search ({'!DataSource' => $db,
- '!Table' => 'category, categoryfields',
+ # warn "tab=\"${table}\" searching for title\n" ;
+ *fields = DBIx::Recordset -> Search ({'!DataSource' => $db,
+ '!Table' => 'category, categoryfields',
+ '!TabRelation' => 'category_id = category.id',
'table_type' => $table,
- 'state' => 1,
+ #'state' => 1,
'typeinfo' => 'title',
'*typeinfo' => 'LIKE',
'$order' => 'position' }) ;
my $title_type = $fields{fieldname};
- #print OUT $title_type;
+ # warn "tt=\"$title_type\" tab=\"${table}text\" ${table}_id as id, $title_type as title" . $fields -> LastSQLStatement . "\n" ;
*set = DBIx::Recordset -> Search ({'!DataSource' => $db,
'!Table' => $table.'text',
'language_id' => $r -> param -> language,
- '!Fields' => $table."_id as id,$title_type as title",
+ '!Fields' => $table."_id as id, $title_type as title",
}) ;
+
return \@set;
}
@@ -1074,4 +1195,4 @@
}
-
+
1.4 +94 -29 embperl/eg/web/db/list.epl
Index: list.epl
===================================================================
RCS file: /home/cvs/embperl/eg/web/db/list.epl,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- list.epl 2 Jan 2003 07:39:44 -0000 1.3
+++ list.epl 7 Aug 2005 15:59:09 -0000 1.4
@@ -1,13 +1,64 @@
[-
$r = shift ;
$set = $r -> {item_set} ;
+$$set -> Reset ;
$tt = $r->{category_set}{table_type};
-$cy = $r->{category_types};
+$cy = $r->{category_types};
$cf = $r->{category_fields};
+$cfnl = $r->{category_fields_nolang};
$title_type = $r->{category_title_type};
+$fdat{-mode} = $udat{-displaymode} = $fdat{-mode} || $udat{-displaymode} ;
+
-]
+[$ sub show_field $]
+ [* my ($type, $rec) = @_ ; *]
+ [$ if $r->{category_types}{$type} =~ /url/ $]
+ <A HREF="[+ do { local $escmode = 0; $rec -> {$type} } +]">[+ $rec -> {$type} +]</A>
+ [$ elsif $cy->{$type} =~ /pulldown/ $]
+ [+ $r->app->get_title($r,$type,$rec->{$type}) +]
+ [$ else $]
+ [- $txt = $rec -> {$type}; -]
+ [$ if $fdat{-mode} eq 'shortlist' $][-
+ $txt =~ s/\s+/ /gom;
+ if ( length ($txt) > 85 ) {
+ $txt = substr ($txt, 0, 80) . " ..." ;
+ }
+ -][+ $txt +]
+ [$ else $][-
+ @txt = split (/\n/, $txt);
+ -][$ foreach $t (@txt) $][+ $t +]<br>[$ endforeach $]
+ [$ endif $]
+ [$ endif $]
+[$endsub$]
+
+[$ sub show_edit $]
+ [* my ($rec) = @_ ; *]
+ [[
+
+ [+ $rec->{email} +] | [+ $date +]
+ [$ if ($r->{user_id} && $r->{user_id} == $rec->{user_id}) || $r->{user_admin} $]
+ |
+ [+ $r -> gettext($r->{item_set}{state} ? 'display' : 'hide') +]
+ |
+ <A HREF="show.epl?[+ $tt +]_id=[+ $rec->{$tt.'_id'} +]&-show_item=1&category_id=[+ $rec->{category_id} +]">View</A>
+ |
+ <A HREF="add.epl?[+ $tt +]_id=[+ $rec->{$tt.'_id'} +]&-edit_item=1&category_id=[+ $rec->{category_id} +]">Edit</A>
+ [$ endif $]
+ |
+ <a href="#top">Top</a>
+ ]
+
+[$endsub$]
+
+<p>
+[= displaymode =]:
+ [[<a href="list.epl?[+ { %fdat, -mode => 'shortlist' } +]">[= shortlist =]</a>]
+ [[<a href="list.epl?[+ { %fdat, -mode => 'longlist' } +]">[= longlist =]</a>]
+ [[<a href="list.epl?[+ { %fdat, -mode => 'tab' } +]">[= table =]</a>]
+</p>
+
<table width="100%" border="0" cellspacing="0" cellpadding="6">
<tr>
<td class="cPodH1">[+ $r -> {category_set}{category} +]<br>
@@ -17,21 +68,50 @@
<tr><td colspan="2" height="5"></td></tr>
</table>
-<table width="100%" border="0" cellspacing="0" cellpadding="6">
+
+<table width="100%" border="0" cellspacing="3" cellpadding="4">
+[$ if $fdat{-mode} eq 'tab' $]
+[# --- tabelle --- #]
+<tr>
+[$ foreach $type ((@$cfnl, @$cf)) $]
+ [$ if $r->{category_types}{$type} !~ /static/ $]
+ <td valign="top" bgcolor="#bbbbdd">
+<a href="list.epl?[+ { %fdat, -order => $type } +]"><b>[+ $r->{category_texts}{$type.'_text'}
++]</b></a></td>
+ [$endif$]
+[$ endforeach $]
+</tr>
+[$else $]
+[# --- liste --- #]
<colgroup>
<col width="5%">
<col width="90%">
<col width="5%">
</colgroup>
+[$endif$]
+
+ [- $$set -> Reset -]
[$ while ($rec = $$set -> Next) $]
[$ if ($r -> {user_id} and (($r -> {user_id} == $rec->{user_id}) or ($r -> {user_admin}))) $]
-[-
-$date = $rec -> {modtime} ;
+[-
+$date = $rec -> {modtime} ;
$date =~ /^(\d+)-(\d+)-(\d+)/ ;
-$date = $r -> param -> language eq 'de'?"$3.$2.$1":"$2/$3/$1" ;
+$date = $r -> param -> language eq 'de'?"$3.$2.$1":"$1-$2-$3" ;
-]
+[$ if $fdat{-mode} eq 'tab' $]
+[# --- tabelle --- #]
+<tr>
+[$ foreach $type ((@$cfnl, @$cf)) $]
+ [$ if $r->{category_types}{$type} !~ /static/ $]
+ <td valign="top" bgcolor="#eeeeee">[- show_field($type, $rec) -]</td>
+ [$endif$]
+[$ endforeach $]
+ <td valign="top">[- show_edit($rec) -]</td>
+</tr>
+[$else $]
+[# --- liste --- #]
<tr>
<td colspan="2" class="cPodH2">
[$ if $cy->{$title_type} =~ /pulldown/ $]
@@ -40,34 +120,19 @@
[+ $rec -> {$title_type} +]
[$ endif $]
</td>
- <td align="right" nowrap class="cPodH2Link">
- [
- [+ $date +]
- [$ if ($r->{user_id} && $r->{user_id} == $rec->{user_id}) || $r->{user_admin} $]
- |
- [+ $r -> gettext($r->{item_set}{state} ? 'display' : 'hide') +]
- |
- <A HREF="add.epl?[+ $tt +]_id=[+ $rec->{$tt.'_id'} +]&-edit_item=1&category_id=[+ $rec->{category_id} +]">Edit</A>
- [$ endif $]
- |
- <a href="#top">Top</a>
- ]
- </td>
+ <td align="right" nowrap class="cPodH2Link">[- show_edit($rec) -]</td>
</tr>
-[$ foreach $type (grep { $_ ne $title_type } @$cf) $]
-<tr>
-<td><b>[+ $r->{category_texts}{$type.'_text'} +]</b></td>
-<td colspan="2"><p>
-[$ if $r->{category_types}{$type} =~ /url/ $]
-<A HREF="[+ do { local $escmode = 0; $rec -> {$type} } +]">[+ $rec -> {$type} +]</A>
-[$ else $]
-[+ $rec -> {$type} +]
-[$ endif $]
-</p></td>
-</tr>
+[$ foreach $type (grep { $_ ne $title_type } (@$cfnl, @$cf)) $]
+ [$ if $r->{category_types}{$type} !~ /static/ $]
+ <tr>
+ <td valign="top"><b>[+ $r->{category_texts}{$type.'_text'} +]</b></td>
+ <td colspan="2" valign="top">[- show_field($type, $rec) -]</td>
+ </tr>
+ [$endif$]
[$ endforeach $]
+[$endif$]
[$ endif $]
[$ endwhile $]
</table>
1.8 +12 -7 embperl/eg/web/db/loginform.epl
Index: loginform.epl
===================================================================
RCS file: /home/cvs/embperl/eg/web/db/loginform.epl,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- loginform.epl 16 Jan 2003 07:14:35 -0000 1.7
+++ loginform.epl 7 Aug 2005 15:59:09 -0000 1.8
@@ -12,8 +12,8 @@
'newuser');
-$r = shift
-
+$r = shift ;
+$fdat{user_email} ||= $fdat{email} ;
-]
<script>
@@ -23,11 +23,11 @@
[$ if not $udat{user_id}$]
- [$ if ($fdat{-newuser} || $dat{-newpassword}) && !$r -> {error}$]
+ [$ if ($fdat{-newuser} || $fdat{-newpassword}) && !$r -> {error}$]
<p>[= loginnew =]</P>
- [$else$]
- <p>[= login1 =]</P>
- [$endif$]
+ [$else$]
+ <p>[= login1 =]</P>
+ [$endif$]
<form action="[+ $param[0] +]" method="POST" name="login" onSubmit="return epform_validate_login()">
<table>
@@ -55,12 +55,17 @@
<P ALIGN="left">[= login3 =]</P>
- <form action="[+ $r -> app -> posturl('login.epl') +]" method="POST" name="newuser" onSubmit="return epform_validate_newuser()">
+ <form action="[+ $param[0] +][#+ $r -> app -> posturl('login.epl') +#]" method="POST" name="newuser" onSubmit="return epform_validate_newuser()">
<table>
<tr>
<td class="cText">[= user_email =]</td>
<td class="cInput"><input type="text" name="user_email"></td>
</tr>
+ <tr>
+ [- $fdat{user_name} ||= "$fdat{firstname} $fdat{lastname}" -]
+ <td class="cText">[= user_name =]</td>
+ <td class="cInput"><input type="text" name="user_name"></td>
+ </tr>
</table>
<p>
<input type="submit" name="-newuser" value="[= newuser =]">
1.4 +123 -18 embperl/eg/web/db/show.epl
Index: show.epl
===================================================================
RCS file: /home/cvs/embperl/eg/web/db/show.epl,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- show.epl 20 Nov 2002 06:56:27 -0000 1.3
+++ show.epl 7 Aug 2005 15:59:09 -0000 1.4
@@ -1,4 +1,4 @@
-[-
+[-
$r = shift ;
-]
@@ -9,32 +9,98 @@
[= edit1 =] [+ $r->{category_set}{category} +]
[$ elsif $fdat{-delete_item} $]
[= del1 =]
- [$ else $]
+ [$ elsif $fdat{-add_item} $]
[= add1 =] [+ $r->{category_set}{category} +]
+ [$ else $]
+ [# [= show1 =] #][+ $r->{category_set}{category} +]
[$ endif $]
</font></td>
</tr>
</table>
-[$ if $fdat{-delete_item} && !$r->{error} $]
-<P>[= del2 =]</P>
-
-<P><A HREF="addsel.epl">[= back_to_index =]</A></P>
-[$ endif $]
[$ if ($item_set = $r->{item_set}) $] [# && (ref ($item_set) ne 'ARRAY' || @$item_set > 0) $]#]
-[= show2 =]<br><br>
+ [$ if $fdat{-update_item} $]
+ [= edit2 =]
+ [$ elsif $fdat{-delete_item} $]
+ [= del2 =]
+ [$ elsif $fdat{-add_item} $]
+ [= add2 =]
+ [$ else $]
+ [= show2 =]
+ [$ endif $]
+
+[$ if $fdat{-delete_item} && !$r->{error} $]
+<P><A HREF="addsel.epl">[= back_to_index =]</A></P>
+[$ endif $]
-Status: [+ eval { $r -> gettext ($item_set->{state} ? 'display' : 'hide') } +]
+<br>
[-
- $ct = $r->{category_texts};
- $cy = $r->{category_types};
+ $ct = $r->{category_texts};
+ $cy = $r->{category_types};
$cf = $r->{category_fields};
+ $cfnl = $r->{category_fields_nolang};
+ $rec = $item_set->[0] ;
+ $email = $rec -> {email} ;
+ $date = $item_set -> {modtime} ;
+ $date =~ /^(\d+)-(\d+)-(\d+)/ ;
+ $date = $r -> param -> language eq 'de'?"$3.$2.$1":"$1-$2-$3" ;
+ $status = eval { $r -> gettext ($item_set->{state} ? 'display' : 'hide') } ;
-]
+[# <pre>[- use Data::Dumper -][+ Dumper ($cfnl, $rec) +]</pre> #]
+[$if $cfnl && @$cfnl $]
+<table width="100%">
+ <tr>
+ <td>
+ <table>
+ [$ foreach $type (@$cfnl) $]
+ [$ if $txt = $ct->{$type . '_text'} $]
+ [$ if $cy->{$type} =~ /showstatic/ $]
+ [- @txt = split (/\n/, $txt) -][$ foreach $t (@txt) $][+ $t +]<br>[$ endforeach $]
+ [$ elsif $cy->{$type} !~ /static/ $]
+ <tr>
+ <td valign=top>[+ $txt +]:</td><td>
+ [$ if $cy->{$type} =~ /pulldown/ $]
+ [+ $r->app->get_title($r,$type,$rec->{$type}) +]
+ [$ elsif $cy->{$type} =~ /checkboxrow/ $]
+ [-
+ %selected = map { $_ => 1 } split ("\t", $rec->{$type});
+ #warn "selected checkboxes: ", Data::Dumper->Dumper (\%selected), "\n";
+ if ($type =~ /^(.*?)_id$/) {
+ $table = $1 ;
+ } else {
+ $table = $type;
+ }
+ $table =~ s/^.*__// ;
+ $poss = $r->app->get_titles($r,$table);
+ $i = 0;
+ $moreThanOne = 0;
+ -]
+ [$ while $t = ($poss->[$i++]) $]
+ [# - #warn "checkboxrow[$i] = ", Data::Dumper->Dumper ($t), "\n"; - #]
+ [+ $selected{$t->{id}} ? ($moreThanOne++ ? ", " : "") . $t->{title} : "" +]
+ [$ endwhile $]
+ [$ elsif $cy->{$type} =~ /checkbox/ $]
+ <!-- Todo: Internationalisierung per Tabelle ... -->
+ [+ $r -> param -> language eq 'de'?($rec->{$type}?'Ja':'Nein'):($rec->{$type}?'Yes':'No') +]
+ [$ else $]
+ [- @txt = split (/\n/, $rec -> {$type}) -][$ foreach $t (@txt) $][+ $t +]<br>[$ endforeach $]
+ [$ endif $]
+ </td>
+ </tr>
+ [$endif$]
+ [$endif$]
+ [$endforeach$]
+ </table>
+ </td>
+ </tr>
+</table>
+[$endif$]
+[$if $cf && @$cf $]
<table width="100%">
<tr bgcolor="#fefcad">
[- $rec = $item_set->[$row] -]
@@ -44,27 +110,66 @@
<td>
<table>
[$ foreach $type (@$cf) $]
+ [$ if $cy->{$type} !~ /static/ $]
[$ if $txt = $ct->{$type . '_text'} $]
<tr>
- <td valign=top>[+ $txt +]:</td><td>
- [$ if $cy->{$type} =~ /pulldown/ $]
- [+ $r->app->get_title($r,$type,$fdat{$type.'_'.$rec->{language_id}}) +]
- [$ else $]
- [- @txt = split (/\n/, $rec -> {$type}) -][$ foreach $t (@txt) $][+ $t +]<br>[$ endforeach $]
- [$ endif $]
+ <td valign=top>[+ $txt +]:</td>
+ <td>
+ [$ if $cy->{$type} =~ /pulldown/ $]
+ [+ $r->app->get_title($r,$type,$rec->{$type}) +]
+ [$ elsif $cy->{$type} =~ /checkboxrow/ $]
+ [-
+ %selected = map { $_ => 1 } split ("\t", $rec->{$type});
+ if ($type =~ /^(.*?)_id$/) {
+ $table = $1 ;
+ } else {
+ $table = $type;
+ }
+ $table =~ s/^.*__// ;
+ $poss = $r->app->get_titles($r,$table);
+ $i = 0;
+ $moreThanOne = 0;
+ -]
+ [$ while $t = ($poss->[$i++]) $]
+ [- warn "checkboxrow[$i] = ", Data::Dumper->Dumper ($t), "\n"; -]
+ [+ $selected{$t->{id}} ? ($moreThanOne++ ? ", " : "") . $t->{title} : "" +]
+ [$ endwhile $]
+ [$ elsif $cy->{$type} =~ /checkbox/ $]
+ <!-- Todo: Internationalisierung per Tabelle ... -->
+ [$ if $rec->{$type} $]
+ Ja
+ [$ else $]
+ Nein
+ [$ endif $]
+ [$ else $]
+ [- @txt = split (/\n/, $rec-> {$type}) -]
+ [$ foreach $t (@txt) $]
+ [+ $t +]<br>
+ [$ endforeach $]
+ [$ endif $]
</td>
</tr>
[$endif$]
+ [$endif$]
[$endforeach$]
</table>
</td>
</tr>
</table>
+[$endif$]
+<hr>
[$ if $udat{user_email} $]
[- $tt = $r->{category_set}{table_type} -]
-<A HREF="add.epl?[+ $tt +]_id=[+ $fdat{"${tt}_id"} +]&-edit_item=1&category_id=[+ $fdat{category_id} +]">Edit</A>
+<A HREF="add.epl?category_id=[+ $fdat{category_id} +]">[New]</A>
+<A HREF="add.epl?[+ $tt +]_id=[+ $fdat{"${tt}_id"} +]&-edit_item=1&category_id=[+ $fdat{category_id} +]">[Edit]</A>
+<A HREF="list.epl?category_id=[+ $fdat{category_id} +]">[Overview]</A>
[$ endif $]
+ Owner: [+ $email +]
+ Status: [+ $status +]
+ [+ $date +]
+<br>
+
[$ endif $]
1.5 +1 -1 embperl/eg/web/db/updateditem.mail
Index: updateditem.mail
===================================================================
RCS file: /home/cvs/embperl/eg/web/db/updateditem.mail,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- updateditem.mail 7 Jan 2003 20:43:01 -0000 1.4
+++ updateditem.mail 7 Aug 2005 15:59:09 -0000 1.5
@@ -1,4 +1,4 @@
-Hi! [- $r = shift; -]
+Hi! [- $r = shift; $^W=0 -]
[$ if $r->{error} $]
There occured the following errors during item [+ $r->{is_update} ? 'update' : 'creation' +] by [+ $udat{user_email} || '[Unknown user]' +]:
1.6 +22 -84 embperl/eg/webutil/db.schema
Index: db.schema
===================================================================
RCS file: /home/cvs/embperl/eg/webutil/db.schema,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- db.schema 7 Aug 2005 00:03:02 -0000 1.5
+++ db.schema 7 Aug 2005 15:59:09 -0000 1.6
@@ -139,13 +139,12 @@
'!PrimKey' => 'id',
'!Init' =>
[
- { id => 1, state => 1, 'table_type' => 'item' } ,
- { id => 2, state => 1, 'table_type' => 'item' } ,
- { id => 3, state => 1, 'table_type' => 'item' } ,
- { id => 4, state => 1, 'table_type' => 'item' } ,
- { id => 5, state => 1, 'table_type' => 'item' } ,
- { id => 6, state => 1, 'table_type' => 'item' } ,
- { id => 7, state => 1, 'table_type' => 'foo' } ,
+ { id => 1, state => 1, 'table_type' => 'item', edit_level => 2 } ,
+ { id => 2, state => 1, 'table_type' => 'item', edit_level => 1 } ,
+ { id => 3, state => 1, 'table_type' => 'item', edit_level => 1 } ,
+ { id => 4, state => 1, 'table_type' => 'item', edit_level => 1 } ,
+ { id => 5, state => 1, 'table_type' => 'item', edit_level => 1 } ,
+ { id => 6, state => 1, 'table_type' => 'item', edit_level => 1 } ,
],
},
@@ -159,11 +158,21 @@
'language_id' => 'varchar(3) not null',
'fieldname' => 'varchar(32) not null',
'txt' => 'text',
+ 'remark' => 'text',
'typeinfo' => 'tinytext',
'position' => 'integer',
+ 'nolang' => 'integer',
+ 'view_level' => 'integer',
+ 'edit_level' => 'integer',
+ 'validate' => 'text',
],
'!PrimKey' => 'category_id,language_id,fieldname',
- #'!PrimKey' => 'category_id',
+ '!Default' =>
+ {
+ 'view_level' => 0,
+ 'edit_level' => 1,
+ },
+
'!Init' =>
[
# News
@@ -215,19 +224,6 @@
{ category_id => 6, language_id => 'en', fieldname => 'description', typeinfo => 'textarea', txt => 'Description', typeinfo => 'textarea', position => 3 } ,
{ category_id => 6, language_id => 'en', fieldname => 'url', txt => 'URL', typeinfo => 'url', position => 2 } ,
- # Test
- { category_id => 7, language_id => 'de', fieldname => 'foo', txt => 'Foo!', typeinfo => 'title', position => 1 } ,
- { category_id => 7, language_id => 'de', fieldname => 'bar', txt => 'Bar!', position => 2 } ,
- { category_id => 7, language_id => 'de', fieldname => 'fnord', txt => 'Fnord!', position => 3 } ,
- { category_id => 7, language_id => 'de', fieldname => 'fubar', txt => 'Fubar!', position => 4 } ,
- { category_id => 7, language_id => 'de', fieldname => 'Baz', txt => 'Bazzz!', typeinfo => 'url', position => 5 } ,
-
- { category_id => 7, language_id => 'en', fieldname => 'foo', txt => 'foo!', typeinfo => 'title', position => 1 } ,
- { category_id => 7, language_id => 'en', fieldname => 'bar', txt => 'bar!', position => 2 } ,
- { category_id => 7, language_id => 'en', fieldname => 'fnord', txt => 'fnord!', position => 3 } ,
- { category_id => 7, language_id => 'en', fieldname => 'fubar', txt => 'fubar!', position => 4 } ,
- { category_id => 7, language_id => 'en', fieldname => 'Baz', txt => 'bazzz!', typeinfo => 'url', position => 5 } ,
-
],
},
@@ -242,11 +238,9 @@
'language_id' => 'varchar(2)',
'category' => 'tinytext',
'add_info' => 'text',
- # Deprecated:
- 'heading_text' => 'tinytext',
- 'keywords_text' => 'tinytext',
- 'description_text' => 'tinytext',
- 'url_text' => 'tinytext',
+ 'headline' => 'tinytext',
+ 'sendtext' => 'tinytext',
+ 'logintext' => 'text',
],
'!PrimKey' => 'id',
'!Init' =>
@@ -286,7 +280,7 @@
'!Fields' =>
[
'id' => 'counter',
- 'name' => 'tinytext',
+ 'user_name' => 'tinytext',
'email' => 'tinytext',
'password' => 'tinytext',
'admin' => 'bit',
@@ -297,62 +291,6 @@
) ;
-=pod
-
-# ----------------------------------------------------------------------
-# ----------------------------------------------------------------------
-# ----------------------------------------------------------------------
-# ----------------------------------------------------------------------
-# ----------------------------------------------------------------------
-# TEST
-# ----------------------------------------------------------------------
-# ----------------------------------------------------------------------
-# ----------------------------------------------------------------------
-# ----------------------------------------------------------------------
-# ----------------------------------------------------------------------
-
- {
- '!Table' => 'foo',
- '!Fields' =>
- [
- 'id' => 'counter',
- 'url' => 'tinytext',
- 'category_id' => 'integer',
- 'state' => 'integer',
- 'creationtime' => 'datetime',
- 'modtime' => 'datetime',
- 'user_id' => 'integer',
- 'checkcount' => 'integer',
- ],
- '!PrimKey' => 'id',
- '!Init' =>
- [
- ]
- },
-
-# ----------------------------------------------------------------------
-
- {
- '!Table' => 'footext',
- '!Fields' =>
- [
- 'id' => 'counter',
- 'foo_id' => 'integer',
- 'language_id' => 'varchar(2)',
- 'foo' => 'tinytext',
- 'bar' => 'tinytext',
- 'fnord' => 'tinytext',
- 'fubar' => 'tinytext',
- 'baz' => 'tinytext',
- ],
- '!PrimKey' => 'id',
- '!Init' =>
- [
- ]
- },
-
-=cut
-
1 ;
---------------------------------------------------------------------
To unsubscribe, e-mail: embperl-cvs-unsubscribe@perl.apache.org
For additional commands, e-mail: embperl-cvs-help@perl.apache.org