richter 2002/11/19 14:31:15
Modified: eg/web/db Tag: Embperl2c epwebapp.pl list.epl loginform.epl
show.epl
eg/webutil Tag: Embperl2c db.schema
podsrc Tag: Embperl2c Config.spod
Log:
docs & web & validate
Revision Changes Path
No revision
No revision
1.1.2.16 +263 -17 embperl/eg/web/db/epwebapp.pl
Index: epwebapp.pl
===================================================================
RCS file: /home/cvs/embperl/eg/web/db/epwebapp.pl,v
retrieving revision 1.1.2.15
retrieving revision 1.1.2.16
diff -u -r1.1.2.15 -r1.1.2.16
--- epwebapp.pl 15 Nov 2002 06:17:45 -0000 1.1.2.15
+++ epwebapp.pl 19 Nov 2002 22:31:14 -0000 1.1.2.16
@@ -12,6 +12,8 @@
my $self = shift ;
my $r = shift ;
+ my $ret ;
+
$self -> SUPER::init ($r) ;
$self -> initdb ($r) ;
@@ -24,6 +26,10 @@
$r -> {language_set} = DBIx::Recordset -> Search ({'!DataSource' => $db,
'!Table' => 'language'}) ;
+
+ $r -> {error} = $fdat{-error} ;
+ $r -> {success} = $fdat{-success} ;
+
if ($fdat{-add_category})
{
@@ -33,19 +39,17 @@
elsif ($fdat{-add_item})
{
$self -> get_category($r) ;
- $self -> add_item($r) ;
- #$self -> get_item_lang($r) ;
+ $ret = $self -> add_item($r) ;
}
elsif ($fdat{-update_item})
{
$self -> get_category($r) ;
- $self -> update_item ($r) ;
- #$self -> get_item_lang($r) ;
+ $ret = $self -> update_item ($r) ;
}
elsif ($fdat{-delete_item})
{
$self -> get_category($r) ;
- $self -> delete_item($r) ;
+ $ret = $self -> delete_item($r) ;
}
elsif ($fdat{-edit_item})
{
@@ -58,13 +62,24 @@
$self -> get_category($r) ;
$self -> get_item_lang($r) ;
}
+ elsif ($fdat{-update_user})
+ {
+ $self -> update_user($r) ;
+ }
else
{
$self -> get_category($r) ;
$self -> get_item($r) ;
+ #$self -> get_user($r);
}
- return 0 ;
+
+ #d# if ($r->param->uri =~ m|/user\.epl$|)
+ #d# {
+ # $self -> get_users($r) if $r->{user_admin};
+ # }
+
+ return defined ($ret)?$ret:0 ;
}
@@ -94,6 +109,11 @@
$r -> {db} = $db ;
+ if ($config->{always_need_login} && ($self -> checkuser($r) < 1))
+ {
+ $r -> {need_login} = 1 ;
+ return ;
+ }
}
# ----------------------------------------------------------------------------
@@ -129,6 +149,21 @@
# 2 admin logged in
#
+sub checkuser_light
+ {
+ my $self = shift ;
+ my $r = shift ;
+
+ if ($udat{user_id} && $udat{user_email} && !$fdat{-logout})
+ {
+ $r -> {user_id} = $udat{user_id} ;
+ $r -> {user_email} = $udat{user_email} ;
+ $r -> {user_admin} = $udat{user_admin} ;
+ return $r -> {user_admin}?2:1 ;
+ }
+ return 0;
+ }
+
sub checkuser
{
my $self = shift ;
@@ -194,23 +229,24 @@
return ;
}
+ my $user_password = '' ;
if ($fdat{-newuser} || $fdat{-newpassword})
{
my $chars =
'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890-+$!#*=@1234567890-+$!#*=@'
;
- $fdat{user_password} = '' ;
for (my $i = 0; $i < 6; $i++)
{
- $fdat{user_password} .= substr($chars, rand(length($chars)), 1) ;
+ $user_password .= substr($chars, rand(length($chars)), 1) ;
}
}
+
if ($fdat{-newuser} && $fdat{user_email})
{
my @errors_user = ();
my @errors_admin = ();
my $set = DBIx::Recordset -> Insert ({'!DataSource' => $r -> {db},
'!Table' => 'user',
- 'password' => $fdat{user_password},
+ 'password' => $user_password,
'email' => $fdat{user_email}}) ;
if (DBIx::Recordset -> LastError)
{
@@ -255,7 +291,7 @@
my @errors_pw;
my $set = DBIx::Recordset -> Update ({'!DataSource' => $r -> {db},
'!Table' => 'user',
- 'password' => $fdat{user_password},
+ 'password' => $user_password,
'email' => $fdat{user_email}}) ;
my $newpw_mail = Embperl::Mail::Execute ({
@@ -276,6 +312,7 @@
return ;
}
+ return ;
}
# ----------------------------------------------------------------------------
@@ -322,7 +359,7 @@
my $self = shift ;
my $r = shift ;
- if (!$self -> checkuser($r))
+ if ($self -> checkuser($r) < $r->{category_set}{edit_level})
{
$r -> {need_login} = 1 ;
return ;
@@ -357,7 +394,7 @@
url => $fdat{url},
category_id => $fdat{category_id},
user_id => $r -> {user_id},
- state => $r ->{user_admin} &&
$fdat{state}?1:0}) ;
+ state => $r ->{user_admin} ?
($fdat{state}?1:0):0}) ;
my $id = $$set -> LastSerial ;
my $langset = $r -> {language_set} ;
@@ -397,6 +434,7 @@
$fdat{"${tt}_id"} = $id ;
+ $r->{item_set} = undef ;
$self->get_item_lang($r);
if (!$udat{user_admin})
@@ -417,6 +455,8 @@
}
$r->{success} = 'suc_item_created';
+
+ return $self -> redir_to_show ($r) ;
}
# ----------------------------------------------------------------------------
@@ -426,7 +466,7 @@
my $self = shift ;
my $r = shift ;
- if (!$self -> checkuser($r))
+ if ($self -> checkuser($r) < $r->{category_set}{edit_level})
{
$r -> {need_login} = 1 ;
return ;
@@ -491,6 +531,7 @@
}
}
+ $r -> {item_set} = undef ;
$self->get_item_lang($r) ;
if (!$udat{user_admin})
@@ -511,7 +552,9 @@
}
}
- $r->{success} = 'suc_item_updated'
+ $r->{success} = 'suc_item_updated' ;
+
+ return $self -> redir_to_show ($r) ;
}
@@ -581,13 +624,42 @@
}
}
- $r->{success} = 'suc_item_deleted'
+ $r->{success} = 'suc_item_deleted' ;
+
+ return $self -> redir_to_show ($r) ;
}
# ----------------------------------------------------------------------------
-# Already working with new db-scheme
+sub redir_to_show
+ {
+ my $self = shift ;
+ my $r = shift ;
+
+ my $tt = $r->{category_set}{table_type};
+
+ my %params =
+ (
+ -show_item => 1,
+ $fdat{category_id} ? (category_id => $fdat{category_id}) : (),
+ $fdat{"${tt}_id"} ? ("${tt}_id" => $fdat{"${tt}_id"}) : (),
+ $r -> {error} ? (-error => $r -> {error}) : (),
+ $r -> {success} ? (-success => $r -> {success}) : (),
+ ) ;
+
+ 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', "show.epl?$dest") ;
+
+ return 301 ;
+ }
+
+
+
+# ----------------------------------------------------------------------------
+
sub get_category
{
@@ -617,7 +689,7 @@
while (my $field = $fields->Next)
{
push(@textfields, $field->{fieldname});
- $texts{$field->{fieldname}.'_text'} = $field->{text};
+ $texts{$field->{fieldname}.'_text'} = $field->{txt};
$types{$field->{fieldname}} = $field->{typeinfo};
# $position{$field->{fieldname}} = $field->{position};
}
@@ -626,6 +698,19 @@
$r -> {category_texts} = \%texts;
$r -> {category_types} = \%types;
# $r -> {category_position} = \%position;
+
+ my $title_type = 'heading';
+ foreach my $f (@textfields)
+ {
+ if ($types{$f} =~ /title/)
+ {
+ $title_type = $f;
+ last;
+ }
+ }
+
+ $r -> {category_title_type} = $title_type;
+
}
@@ -697,6 +782,7 @@
# ${$r->{item_set}}->Reset;
$r->{item_set} = undef unless ${$r->{item_set}}->MoreRecords;
+ ${$r->{item_set}} -> Reset if ($r->{item_set}) ;
}
@@ -738,5 +824,165 @@
}
}
+ $$set -> Reset ;
$r -> {edit} = 1 ;
}
+
+
+# ----------------------------------------------------------------------------
+
+sub get_user
+ {
+ my $self = shift ;
+ my $r = shift ;
+
+ $fdat{user_id} = undef unless $r -> {user_admin};
+
+ $r -> {user_set} = DBIx::Recordset -> Search ({'!DataSource' => $r->{db},
+ '!Table' => "user",
+ id => $fdat{user_id} ||
$udat{user_id}
+ }) ;
+ $r->{user_set} = undef unless ${$r->{user_set}}->MoreRecords;
+ }
+
+# ----------------------------------------------------------------------------
+
+sub get_users
+ {
+ my $self = shift ;
+ my $r = shift ;
+
+ if ($self -> checkuser_light($r) < 1)
+ {
+ $r -> {need_login} = 1 ;
+ return ;
+ }
+
+ return unless $r -> {user_admin};
+
+ $r -> {users} = DBIx::Recordset -> Search ({'!DataSource' => $r->{db},
+ '!Table' => "user" }) ;
+ $r->{users} = undef unless ${$r->{users}}->MoreRecords;
+ }
+
+
+# ----------------------------------------------------------------------------
+
+sub update_user
+ {
+ my $self = shift ;
+ my $r = shift ;
+
+ if ($self -> checkuser_light($r) < 1)
+ {
+ $r -> {need_login} = 1 ;
+ return ;
+ }
+
+ unless (($fdat{user_id} == $udat{user_id}) or $r->{user_admin})
+ {
+ $r->{error} = 'err_cannot_update_wrong_user_xxx';
+ return;
+ }
+
+ eval { *set = DBIx::Recordset -> Update ({'!DataSource' => $r->{db},
+ '!Table' => "user",
+ 'name' => $fdat{name},
+ 'pid' => $fdat{pid} },
+ { id => $fdat{user_id} ||
$udat{user_id}}) ; };
+
+
+ if ($@ and $@ =~ 'Duplicate entry')
+ {
+ $r->{error} = 'err_pid_exists';
+ return;
+ }
+
+ if (DBIx::Recordset->LastError)
+ {
+ $r->{error} = 'err_update_db';
+ push(@{$r->{error_details}}, DBIx::Recordset->LastError
+ );
+ }
+
+ $r->{success} = 'suc_user_update';
+
+ }
+
+# ----------------------------------------------------------------------------
+# Warning: This will not yet work as intended if there is more than
+# one category using $table as category type!
+
+sub get_title
+ {
+ my ($self, $r, $col, $id) = @_;
+
+ (my $table = $col) =~ s/_id$// or die "Can't strip '_id'";
+
+ my $config = $r->{config};
+ my $db = DBIx::Database -> new ({'!DataSource' => $config -> {dbdsn},
+ '!Username' => $config -> {dbuser},
+ '!Password' => $config -> {dbpassword},
+ '!DBIAttr' => { RaiseError => 1, PrintError
=> 1, LongReadLen => 32765, LongTruncOk => 0, }});
+
+
+ # SQL can't handle such kind soft links, so we need two requests
+ *fields = DBIx::Recordset -> Search ({'!DataSource' => $db,
+ '!Table' => 'category,
categoryfields',
+ 'table_type' => $table,
+ 'state' => 1,
+ 'typeinfo' => 'title',
+ '*typeinfo' => 'LIKE',
+ '$order' => 'position' }) ;
+
+ *set = DBIx::Recordset -> Search ({'!DataSource' => $db,
+ '!Table' => $table.'text',
+ 'language_id' => $r -> param -> language,
+ $table.'_id' => $id }) ;
+
+ return $set{$fields{fieldname}};
+ }
+
+# ----------------------------------------------------------------------------
+# Warning: This will not yet work as intended if there is more than
+# one category using $table as category type!
+
+sub get_titles
+ {
+ my ($self, $r, $table) = @_;
+
+# *set = DBIx::Recordset -> Search ({'!DataSource' => $r->{db},
+# '!Fields' => "id,$r->{category_title_type}
as title",
+# '!Table' => $table, }) ;
+# print OUT Dumper $config;
+#
+# return;
+
+ my $config = $r->{config};
+ my $db = DBIx::Database -> new ({'!DataSource' => $config -> {dbdsn},
+ '!Username' => $config -> {dbuser},
+ '!Password' => $config -> {dbpassword},
+ '!DBIAttr' => { RaiseError => 1, PrintError
=> 1, LongReadLen => 32765, LongTruncOk => 0, },
+ }) ;
+
+ # SQL can't handle such kind soft links, so we need two requests
+ *fields = DBIx::Recordset -> Search ({'!DataSource' => $db,
+ '!Table' => 'category,
categoryfields',
+ 'table_type' => $table,
+ 'state' => 1,
+ 'typeinfo' => 'title',
+ '*typeinfo' => 'LIKE',
+ '$order' => 'position' }) ;
+ my $title_type = $fields{fieldname};
+ #print OUT $title_type;
+
+ *set = DBIx::Recordset -> Search ({'!DataSource' => $db,
+ '!Table' => $table.'text',
+ 'language_id' => $r -> param -> language,
+ '!Fields' => $table."_id as id,$title_type
as title",
+ }) ;
+
+ return \@set;
+ }
+
+
1.1.2.2 +11 -16 embperl/eg/web/db/Attic/list.epl
Index: list.epl
===================================================================
RCS file: /home/cvs/embperl/eg/web/db/Attic/list.epl,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -u -r1.1.2.1 -r1.1.2.2
--- list.epl 19 Nov 2002 03:45:01 -0000 1.1.2.1
+++ list.epl 19 Nov 2002 22:31:14 -0000 1.1.2.2
@@ -2,25 +2,16 @@
$r = shift ;
$set = $r -> {item_set} ;
-$title_type = 'heading';
$tt = $r->{category_set}{table_type};
+$cy = $r->{category_types};
$cf = $r->{category_fields};
-foreach my $f (@$cf)
- {
- if ($r->{category_types}{$f} =~ /title/)
- {
- $title_type = $f;
- last;
- }
- }
-
-#$escmode = 0 ;
+$title_type = $r->{category_title_type};
-]
<table width="100%" border="0" cellspacing="0" cellpadding="6">
<tr>
-<td class="cPodH1">[+ $r -> {category_set}{category} +]</td>
-<td class="cPodH1Link"><a href="add.-category_id-[+ $fdat{category_id}
+]-.epl">[Eintrag hinzufügen]</a></td>
+<td class="cPodH1">[+ $r -> {category_set}{category} +] ([= items_of =] [+ $r ->
{user_email} +][+ $r->{user_admin}?"[admin]":'' +])</td>
+<td class="cPodH1Link"><a href="add.epl?category_id=[+ $fdat{category_id} +]">[=
add_item =]</a></td>
</tr>
<tr><td colspan="2" height="5"></td></tr>
</table>
@@ -33,7 +24,7 @@
</colgroup>
[$ while ($rec = $$set -> Next) $]
-[$ if ($udat{user_id} and (($udat{user_id} == $rec->{user_id}) or
($udat{user_admin}))) $]
+[$ if ($r -> {user_id} and (($r -> {user_id} == $rec->{user_id}) or ($r ->
{user_admin}))) $]
[-
$date = $rec -> {modtime} ;
$date =~ /^(\d+)-(\d+)-(\d+)/ ;
@@ -42,14 +33,18 @@
<tr bgcolor="#D2E9F5">
<td colspan="2" nowrap><font size="2" face="Verdana, Arial, Helvetica,
sans-serif" color="#000000"><b>
- [+ $rec -> {$title_type} +]
+ [$ if $cy->{$title_type} =~ /pulldown/ $]
+ [+ $r->app->get_title($r,$title_type,$rec->{$title_type}) +]
+ [$ else $]
+ [+ $rec -> {$title_type} +]
+ [$ endif $]
</b></font></td>
<td align="right" nowrap><font size="1">
[
[+ $date +]
[$ if ($r->{user_id} && $r->{user_id} == $rec->{user_id}) || $r->{user_admin}
$]
|
- [+ $r->{item_set}{state} ? 'Shown' : 'Hidden' +]
+ [+ $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 $]
1.1.2.4 +68 -15 embperl/eg/web/db/Attic/loginform.epl
Index: loginform.epl
===================================================================
RCS file: /home/cvs/embperl/eg/web/db/Attic/loginform.epl,v
retrieving revision 1.1.2.3
retrieving revision 1.1.2.4
diff -u -r1.1.2.3 -r1.1.2.4
--- loginform.epl 25 Oct 2002 13:21:10 -0000 1.1.2.3
+++ loginform.epl 19 Nov 2002 22:31:14 -0000 1.1.2.4
@@ -1,32 +1,85 @@
-[- $r = shift -]
+[-
+use Embperl::Form::Validate;
- <div align=left>
- <blockquote>
- <ul>
- <li>[= login1 =]</li>
- <li>[= login2 =]</li>
- <li>[= login3 =]</li>
- </ul>
- </blockquote>
- </div>
-
- <form action="[+ $param[0] +]" method="POST">
+$epf1 = new Embperl::Form::Validate([ -key => 'user_email', required => 1,
+ -key => 'user_password',
+ required => 1,
+ length_min => 5],
+ 'login');
+
+$epf2 = new Embperl::Form::Validate([ -key => 'user_email', required => 1],
+ 'newuser');
+
+
+$r = shift
+
+
+-]
+ <script>
+ [+ do { local $escmode = 0 ; $epf1 -> get_script_code } +]
+ [+ do { local $escmode = 0 ; $epf2 -> get_script_code } +]
+ </script>
+
+
+ [$ if not $udat{user_id}$]
+ [$ if $fdat{-newuser} || $dat{-newpassword} $]
+ <p>[= loginnew =]</P>
+ [$else$]
+ <p>[= login1 =]</P>
+ [$endif$]
+
+ <form action="[+ $param[0] +]" method="POST" name="login" onSubmit="return
epform_validate_login()">
<table>
<tr>
- <td class="cText">[= email =]</td>
+ <td class="cText">[= user_email =]</td>
<td class="cInput"><input type="text" name="user_email"></td>
</tr>
<tr>
- <td class="cText">[= password =]</td>
+ <td class="cText">[= user_password =]</td>
<td class="cInput"><input type="password" name="user_password"></td>
</tr>
</table>
<p>
<input type="submit" name="-login" value="[= login =]">
+ [$ hidden $]
+ </p>
+ </form>
+
+ <p>[= cookie_note =]</p>
+
+ [$ if !$fdat{-newuser} && !$dat{-newpassword} $]
+
+ <hr>
+ <P ALIGN="left">[= login2 =]</P>
+
+ <P ALIGN="left">[= login3 =]</P>
+
+ <form action="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>
+ </table>
+ <p>
<input type="submit" name="-newuser" value="[= newuser =]">
<input type="submit" name="-newpassword" value="[= newpassword =]">
+ [$ hidden $]
+ </p>
+ </form>
+ [$ endif $]
+ [$ else $]
+ <form action="[+ $param[0] +]" method="POST">
+ <p>
+ [= already_logged_in_as =] [+ $udat{user_email} +]
+ [$ if $udat{user_admin} $]
+ [Admin]
+ [$ endif $]
+ <p>
+ [= logoff =]
+ <p>
<input type="submit" name="-logout" value="[= logout =]">
[$ hidden $]
</p>
</form>
- <p>[= cookie_note =]</p>
+ [$ endif $]
1.1.2.8 +24 -10 embperl/eg/web/db/show.epl
Index: show.epl
===================================================================
RCS file: /home/cvs/embperl/eg/web/db/show.epl,v
retrieving revision 1.1.2.7
retrieving revision 1.1.2.8
diff -u -r1.1.2.7 -r1.1.2.8
--- show.epl 15 Nov 2002 06:17:45 -0000 1.1.2.7
+++ show.epl 19 Nov 2002 22:31:14 -0000 1.1.2.8
@@ -16,14 +16,24 @@
</tr>
</table>
-[$ if ($item_set = $r->{item_set}) $]
-[$ if $fdat{-delete_item} $]
-[= del2 =]
-[$ else $]
+[$ 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>
-Status: [#+ $item_set->{state} ? 'Shown' : 'Hidden' +#]
+Status: [+ eval { $r -> gettext ($item_set->{state} ? 'display' : 'hide') } +]
+
+[-
+ $ct = $r->{category_texts};
+ $cy = $r->{category_types};
+ $cf = $r->{category_fields};
+-]
<table width="100%">
<tr bgcolor="#fefcad">
@@ -33,10 +43,16 @@
<tr>
<td>
<table>
- [$ foreach $type (@{$r->{category_fields}}) $]
- [$ if $txt = $r -> {category_texts}{$type . '_text'} $]
+ [$ foreach $type (@$cf) $]
+ [$ if $txt = $ct->{$type . '_text'} $]
<tr>
- <td valign=top>[+ $txt +]:</td><td>[- @txt = split
(/\n/, $rec -> {$type}) -][$ foreach $t (@txt) $][+ $t +]<br>[$endforeach$]</td>
+ <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>
</tr>
[$endif$]
[$endforeach$]
@@ -48,8 +64,6 @@
[$ 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>
-[$ endif $]
-
[$ endif $]
[$ endif $]
No revision
No revision
1.1.2.10 +62 -58 embperl/eg/webutil/db.schema
Index: db.schema
===================================================================
RCS file: /home/cvs/embperl/eg/webutil/db.schema,v
retrieving revision 1.1.2.9
retrieving revision 1.1.2.10
diff -u -r1.1.2.9 -r1.1.2.10
--- db.schema 15 Nov 2002 06:17:55 -0000 1.1.2.9
+++ db.schema 19 Nov 2002 22:31:14 -0000 1.1.2.10
@@ -69,7 +69,7 @@
[
'id' => 'counter',
'item_id' => 'integer',
- 'language_id' => 'char(2)',
+ 'language_id' => 'varchar(2)',
'heading' => 'tinytext',
'keywords' => 'text',
'description' => 'text',
@@ -113,7 +113,7 @@
'!Table' => 'language',
'!Fields' =>
[
- 'id' => 'char(2) not null',
+ 'id' => 'varchar(2) not null',
'name' => 'tinytext',
],
'!PrimKey' => 'id',
@@ -156,76 +156,77 @@
'!Fields' =>
[
'category_id' => 'integer not null',
- 'language_id' => 'char(3) not null',
- 'fieldname' => 'char(32) not null',
- 'text' => 'text',
+ 'language_id' => 'varchar(3) not null',
+ 'fieldname' => 'varchar(32) not null',
+ 'txt' => 'text',
'typeinfo' => 'tinytext',
'position' => 'integer',
],
'!PrimKey' => 'category_id,language_id,fieldname',
+ #'!PrimKey' => 'category_id',
'!Init' =>
[
# News
- { category_id => 1, language_id => 'de', fieldname => 'description',
text => 'Neuigkeit', position => 1 } ,
- { category_id => 1, language_id => 'en', fieldname => 'description',
text => 'News', position => 1 } ,
+ { category_id => 1, language_id => 'de', fieldname => 'description',
typeinfo => 'textarea', txt => 'Neuigkeit', position => 1 } ,
+ { category_id => 1, language_id => 'en', fieldname => 'description',
typeinfo => 'textarea', txt => 'News', position => 1 } ,
# Emperl Websites
- { category_id => 2, language_id => 'de', fieldname => 'heading',
text => '�berschrift', position => 1 } ,
- { category_id => 2, language_id => 'de', fieldname => 'description',
text => 'Beschreibung', typeinfo => 'textarea', position => 3 } ,
- { category_id => 2, language_id => 'de', fieldname => 'url',
text => 'URL', typeinfo => 'url', position => 2 } ,
-
- { category_id => 2, language_id => 'en', fieldname => 'heading',
text => 'Heading', position => 1 } ,
- { category_id => 2, language_id => 'en', fieldname => 'description',
text => 'Description', typeinfo => 'textarea', position => 3 } ,
- { category_id => 2, language_id => 'en', fieldname => 'url',
text => 'URL', typeinfo => 'url', position => 2 } ,
+ { category_id => 2, language_id => 'de', fieldname => 'heading',
txt => '�berschrift', position => 1 } ,
+ { category_id => 2, language_id => 'de', fieldname => 'description',
typeinfo => 'textarea', txt => 'Beschreibung', typeinfo => 'textarea', position => 3 }
,
+ { category_id => 2, language_id => 'de', fieldname => 'url',
txt => 'URL', typeinfo => 'url', position => 2 } ,
+
+ { category_id => 2, language_id => 'en', fieldname => 'heading',
txt => 'Heading', position => 1 } ,
+ { category_id => 2, language_id => 'en', fieldname => 'description',
typeinfo => 'textarea', txt => 'Description', typeinfo => 'textarea', position => 3 } ,
+ { category_id => 2, language_id => 'en', fieldname => 'url',
txt => 'URL', typeinfo => 'url', position => 2 } ,
# Books about Embperl
- { category_id => 3, language_id => 'de', fieldname => 'heading',
text => 'Titel', position => 1 } ,
- { category_id => 3, language_id => 'de', fieldname => 'description',
text => 'Beschreibung', typeinfo => 'textarea', position => 3 } ,
- { category_id => 3, language_id => 'de', fieldname => 'url',
text => 'URL', typeinfo => 'url', position => 2 } ,
-
- { category_id => 3, language_id => 'en', fieldname => 'heading',
text => 'Title', position => 1 } ,
- { category_id => 3, language_id => 'en', fieldname => 'description',
text => 'Description', typeinfo => 'textarea', position => 3 } ,
- { category_id => 3, language_id => 'en', fieldname => 'url',
text => 'URL', typeinfo => 'url', position => 2 } ,
+ { category_id => 3, language_id => 'de', fieldname => 'heading',
txt => 'Titel', position => 1 } ,
+ { category_id => 3, language_id => 'de', fieldname => 'description',
typeinfo => 'textarea', txt => 'Beschreibung', typeinfo => 'textarea', position => 3 }
,
+ { category_id => 3, language_id => 'de', fieldname => 'url',
txt => 'URL', typeinfo => 'url', position => 2 } ,
+
+ { category_id => 3, language_id => 'en', fieldname => 'heading',
txt => 'Title', position => 1 } ,
+ { category_id => 3, language_id => 'en', fieldname => 'description',
typeinfo => 'textarea', txt => 'Description', typeinfo => 'textarea', position => 3 } ,
+ { category_id => 3, language_id => 'en', fieldname => 'url',
txt => 'URL', typeinfo => 'url', position => 2 } ,
# Embperl articles
- { category_id => 4, language_id => 'de', fieldname => 'heading',
text => 'Titel', position => 1 } ,
- { category_id => 4, language_id => 'de', fieldname => 'description',
text => 'Beschreibung', typeinfo => 'textarea', position => 3 } ,
- { category_id => 4, language_id => 'de', fieldname => 'url',
text => 'URL', typeinfo => 'url', position => 2 } ,
-
- { category_id => 4, language_id => 'en', fieldname => 'heading',
text => 'Title', position => 1 } ,
- { category_id => 4, language_id => 'en', fieldname => 'description',
text => 'Description', typeinfo => 'textarea', position => 3 } ,
- { category_id => 4, language_id => 'en', fieldname => 'url',
text => 'URL', typeinfo => 'url', position => 2 } ,
+ { category_id => 4, language_id => 'de', fieldname => 'heading',
txt => 'Titel', position => 1 } ,
+ { category_id => 4, language_id => 'de', fieldname => 'description',
typeinfo => 'textarea', txt => 'Beschreibung', typeinfo => 'textarea', position => 3 }
,
+ { category_id => 4, language_id => 'de', fieldname => 'url',
txt => 'URL', typeinfo => 'url', position => 2 } ,
+
+ { category_id => 4, language_id => 'en', fieldname => 'heading',
txt => 'Title', position => 1 } ,
+ { category_id => 4, language_id => 'en', fieldname => 'description',
typeinfo => 'textarea', txt => 'Description', typeinfo => 'textarea', position => 3 } ,
+ { category_id => 4, language_id => 'en', fieldname => 'url',
txt => 'URL', typeinfo => 'url', position => 2 } ,
# Syntax highlighting
- { category_id => 5, language_id => 'de', fieldname => 'heading',
text => 'Editor', position => 1 } ,
- { category_id => 5, language_id => 'de', fieldname => 'description',
text => 'Beschreibung', typeinfo => 'textarea', position => 3 } ,
- { category_id => 5, language_id => 'de', fieldname => 'url',
text => 'URL', typeinfo => 'url', position => 2 } ,
-
- { category_id => 5, language_id => 'en', fieldname => 'heading',
text => 'Editor', position => 1 } ,
- { category_id => 5, language_id => 'en', fieldname => 'description',
text => 'Description', typeinfo => 'textarea', position => 3 } ,
- { category_id => 5, language_id => 'en', fieldname => 'url',
text => 'URL', typeinfo => 'url', position => 2 } ,
+ { category_id => 5, language_id => 'de', fieldname => 'heading',
txt => 'Editor', position => 1 } ,
+ { category_id => 5, language_id => 'de', fieldname => 'description',
typeinfo => 'textarea', txt => 'Beschreibung', typeinfo => 'textarea', position => 3 }
,
+ { category_id => 5, language_id => 'de', fieldname => 'url',
txt => 'URL', typeinfo => 'url', position => 2 } ,
+
+ { category_id => 5, language_id => 'en', fieldname => 'heading',
txt => 'Editor', position => 1 } ,
+ { category_id => 5, language_id => 'en', fieldname => 'description',
typeinfo => 'textarea', txt => 'Description', typeinfo => 'textarea', position => 3 } ,
+ { category_id => 5, language_id => 'en', fieldname => 'url',
txt => 'URL', typeinfo => 'url', position => 2 } ,
# Modules and examples
- { category_id => 6, language_id => 'de', fieldname => 'heading',
text => 'Name', position => 1 } ,
- { category_id => 6, language_id => 'de', fieldname => 'description',
text => 'Beschreibung', typeinfo => 'textarea', position => 3 } ,
- { category_id => 6, language_id => 'de', fieldname => 'url',
text => 'URL', typeinfo => 'url', position => 2 } ,
-
- { category_id => 6, language_id => 'en', fieldname => 'heading',
text => 'Name', position => 1 } ,
- { category_id => 6, language_id => 'en', fieldname => 'description',
text => 'Description', typeinfo => 'textarea', position => 3 } ,
- { category_id => 6, language_id => 'en', fieldname => 'url',
text => 'URL', typeinfo => 'url', position => 2 } ,
+ { category_id => 6, language_id => 'de', fieldname => 'heading',
txt => 'Name', position => 1 } ,
+ { category_id => 6, language_id => 'de', fieldname => 'description',
typeinfo => 'textarea', txt => 'Beschreibung', typeinfo => 'textarea', position => 3 }
,
+ { category_id => 6, language_id => 'de', fieldname => 'url',
txt => 'URL', typeinfo => 'url', position => 2 } ,
+
+ { category_id => 6, language_id => 'en', fieldname => 'heading',
txt => 'Name', position => 1 } ,
+ { 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', text
=> 'Foo!', typeinfo => 'title', position => 1 } ,
- { category_id => 7, language_id => 'de', fieldname => 'bar', text =>
'Bar!', position => 2 } ,
- { category_id => 7, language_id => 'de', fieldname => 'fnord',
text => 'Fnord!', position => 3 } ,
- { category_id => 7, language_id => 'de', fieldname => 'fubar', text =>
'Fubar!', position => 4 } ,
- { category_id => 7, language_id => 'de', fieldname => 'Baz',
text => 'Bazzz!', typeinfo => 'url', position => 5 } ,
-
- { category_id => 7, language_id => 'en', fieldname => 'foo', text
=> 'foo!', typeinfo => 'title', position => 1 } ,
- { category_id => 7, language_id => 'en', fieldname => 'bar', text =>
'bar!', position => 2 } ,
- { category_id => 7, language_id => 'en', fieldname => 'fnord',
text => 'fnord!', position => 3 } ,
- { category_id => 7, language_id => 'en', fieldname => 'fubar', text =>
'fubar!', position => 4 } ,
- { category_id => 7, language_id => 'en', fieldname => 'Baz',
text => 'bazzz!', typeinfo => 'url', position => 5 } ,
+ { 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 } ,
],
},
@@ -238,7 +239,7 @@
[
'id' => 'counter',
'category_id' => 'integer',
- 'language_id' => 'char(2)',
+ 'language_id' => 'varchar(2)',
'category' => 'tinytext',
'add_info' => 'text',
# Deprecated:
@@ -293,6 +294,10 @@
'!PrimKey' => 'id',
},
+) ;
+
+
+=pod
# ----------------------------------------------------------------------
# ----------------------------------------------------------------------
@@ -333,7 +338,7 @@
[
'id' => 'counter',
'foo_id' => 'integer',
- 'language_id' => 'char(2)',
+ 'language_id' => 'varchar(2)',
'foo' => 'tinytext',
'bar' => 'tinytext',
'fnord' => 'tinytext',
@@ -346,9 +351,8 @@
]
},
+=cut
-
-) ;
1 ;
No revision
No revision
1.1.2.6 +184 -11 embperl/podsrc/Config.spod
Index: Config.spod
===================================================================
RCS file: /home/cvs/embperl/podsrc/Config.spod,v
retrieving revision 1.1.2.5
retrieving revision 1.1.2.6
diff -u -r1.1.2.5 -r1.1.2.6
--- Config.spod 22 Aug 2002 10:06:44 -0000 1.1.2.5
+++ Config.spod 19 Nov 2002 22:31:14 -0000 1.1.2.6
@@ -1339,9 +1339,9 @@
There are three major objects in Embperl: I<application>, I<request> and
I<component>.
Each of these objects can be used to get information about the processing and
control the execution. Each of these objects has a config sub-object, which makes
-the configuration accessable and where possible changeable at runtime. The C<config>
+the configuration accessable and, where possible, changeable at runtime. The
C<config>
method of these three objects returns a reference to the configuation object. The
methods
-of these configurations objects are decribed in the section L<Configuration>.
+of these configurations objects are described in the section L<Configuration>.
The request and the component object have addtionaly a parameter sub-object, which
holds
parameters passed to the current request/component. The C<param> method of these two
objects returns the parameter sub-object. The methods of these parameter objects
@@ -1349,102 +1349,245 @@
Addtionaly each of the three major objects has a set of own methods, which are
described
here.
-
-B<more is coming soon...>
-
-
=head2 *METHOD $application / / thread / 2.0b6 / no
+Returns a reference to a object which hold per threads informations. There is only
one
+such object per thread.
+
=head2 *METHOD $application / / curr_req / 2.0b6 / no
+Returns a reference to the current request object i.e. the object of the
+request currently running.
+
=head2 *METHOD $application / / config / 2.0b6 / no
+Returns a reference to the configuration object of the application. See section
L<Configuration>.
+
=head2 *METHOD $application / / user_session / 2.0b6 / no
+Returns a reference to the user session object.
+
=head2 *METHOD $application / / state_session / 2.0b6 / no
+Returns a reference to the state session object.
+
=head2 *METHOD $application / / app_session / 2.0b6 / no
+Returns a reference to the application session object.
+
=head2 *METHOD $application / / udat / 2.0b6 / no
+Returns a reference to a hash which contains the data of the user session.
+This has can be used to access and modify user session data. It's the same
+as accessing the global L<%udat>.
+
=head2 *METHOD $application / / sdat / 2.0b6 / no
+Returns a reference to a hash which contains the data of the state session.
+This has can be used to access and modify state session data. It's the same
+as accessing the global L<%sdat>.
+
=head2 *METHOD $application / / mdat / 2.0b6 / no
-=head2 *METHOD $application / / debug / 2.0b6 / yes
+Returns a reference to a hash which contains the data of the application session.
+This has can be used to access and modify application session data. It's the same
+as accessing the global L<%mdat>.
+
=head2 *METHOD $application / / errors_count / 2.0b6 / yes
+Contains the number of errors since last time send per mail. See also
L<mail_errors_to>.
+
=head2 *METHOD $application / / errors_last_time / 2.0b6 / yes
+Time when the last error has occured. See also L<mail_errors_to>.
+
=head2 *METHOD $application / / errors_last_send_time / 2.0b6 / yes
+Time when the last mail with error messages was sent. See also L<mail_errors_to>.
+
=head2 *METHOD $request / / apache_req / 2.0b6 / no
+Returns a reference to mod_perls Apache request object. In mod_perl 1 this is of
+type C<Apache::> in mod_perl 2 it's a C<Apache::RequestRec>.
+
=head2 *METHOD $request / / config / 2.0b6 / no
+Returns a reference to the configuration object of the request. See section
L<Configuration>.
+
=head2 *METHOD $request / / param / 2.0b6 / no
+Returns a reference to the parameter object of the request. See section
L<Parameters>.
+
=head2 *METHOD $request / / component / 2.0b6 / no
+Returns a reference to the object of component currently running. See component
methods below.
+
=head2 *METHOD $request / / app / 2.0b6 / no
+Returns a reference to the object of application to which the current request
belongs.
+See application methods above.
+
+
=head2 *METHOD $request / / thread / 2.0b6 / no
+Returns a reference to a object which hold per threads informations. There is only
one
+such object per thread.
+
=head2 *METHOD $request / / request_count / 2.0b6 / no
+Returns the number of request handled so far by this child process.
+
=head2 *METHOD $request / / request_time / 2.0b6 / no
-=head2 *METHOD $request / / session_mgnt ??? / 2.0b6 / no
+Start time of the current request.
+
+=head2 *METHOD $request / / session_mgnt / 2.0b6 / no
+
+Set to true if session management is available.
=head2 *METHOD $request / / session_id / 2.0b6 / no
+Combined id of current user and state session.
+
=head2 *METHOD $request / / session_state_id / 2.0b6 / no
+Id of the current state session as received by the browser, this
+means this method returns C<undef> for a new session.
+
=head2 *METHOD $request / / session_user_id / 2.0b6 / no
+Id of the current user session as received by the browser, this
+means this method returns C<undef> for a new session.
+
=head2 *METHOD $request / / had_exit / 2.0b6 / no
+True if exit was called in one of the components processed so far.
+
=head2 *METHOD $request / / log_file_start_pos / 2.0b6 / no
+File possition of the log file at the time when the request has started.
+
=head2 *METHOD $request / / error / 2.0b6 / yes
+True if there were any error during the request.
+
=head2 *METHOD $request / / errors / 2.0b6 / yes
+Reference to an array which holds all error messages occured so far.
+
=head2 *METHOD $request / / errdat1 / 2.0b6 / yes
+Additional informations passed to the error handler when an error is reported.
+
=head2 *METHOD $request / / errdat2 / 2.0b6 / yes
+Additional informations passed to the error handler when an error is reported.
+
=head2 *METHOD $request / / lastwarn / 2.0b6 / yes
+Last warning message.
+
=head2 *METHOD $request / / cleanup_vars / 2.0b6 / yes
+Reference to an array which is filled with references to variables that should be
+cleaned up after the request. You can add your own variables that needs cleanup
here,
+but you should never remove any variables from this array.
+
=head2 *METHOD $request / / cleanup_packages / 2.0b6 / yes
+Refernce to a hash which contains all packages that must be cleaned up after the
request.
+
=head2 *METHOD $request / / initial_cwd / 2.0b6 / no
+Working directory when the request started.
+
=head2 *METHOD $request / / messages / 2.0b6 / yes
+Reference to an array of hashs of messages. This is used by Embperl to translate
+message into different languages. When a C<[= =]> block is processed or
+$request -> gettext is called, Embperl searches this array. It starts from the first
+element in the array (each element in the array must be a hashref) and tries to
+lookup the text for the given symbol in hash. When it fails it goes to the
+next array element. This way you can setup multiple translation tables that are
search
+for the symbol. Example:
+
+ %messages =
+ (
+ 'de' =>
+ {
+ 'addsel1' => 'Klicken Sie auf die Kategorie zu der Sie etwas hinzuf�gen
m�chten:',
+ 'addsel2' => 'oder f�gen Sie eine neue Kategorie hinzu. Bitte geben Sie
die Beschreibung in so vielen Sprachen wie Ihnen m�glich ein.',
+ 'addsel3' => 'Falls Sie die �bersetzung nicht wissen, lassen Sie das
entsprechende Eingabefeld leer.',
+ 'addsel4' => 'Kategorie hinzuf�gen',
+ },
+ 'en' =>
+ {
+ 'addsel1' => 'Click on the category for wich you want to add a new
item:',
+ 'addsel2' => 'or add new category. Please enter the description in as
much languages as possible.',
+ 'addsel3' => 'If you don\'t know the translation leave the
corresponding input field empty.',
+ 'addsel4' => 'Add category',
+ }
+ ) ;
+
+
+ $lang = $request -> param -> language ;
+ push @{$request -> messages}, $messages{$lang} ;
+ push @{$request -> default_messages}, $messages{'en'} if ($lang ne 'en') ;
+
+C<$request -> param -> language> retrieves the language as given by the browser
+language-accept header (or set before in your program). Then it pushes the german
+or english messages hash onto the message array. Addtionaly it pushes the english
+messages on the default_messages array. Messages will be taken from this array
+if nothing can be found in the messages array.
+
+
=head2 *METHOD $request / / default_messages / 2.0b6 / yes
+Reference to an array with default messages. Messages will be taken from this array
+if nothing can be found in the L<messages> array.
+
+
=head2 *METHOD $component / / config / 2.0b6 / no
+Returns an reference to the configuration object of the component.
+
=head2 *METHOD $component / / param / 2.0b6 / no
+Returns an reference to the parameter object of the component.
+
=head2 *METHOD $component / / req_running / 2.0b6 / no
+True if Embperl is inside of the execution of the request.
+
=head2 *METHOD $component / / sub_req / 2.0b6 / no
+True is this is not the outermost Embperl component, i.e. this component is
+called from within another component.
+
=head2 *METHOD $component / / inside_sub / 2.0b6 / no
+True is we are inside a Embperl subroutine ([$ sub $] ... [$ endsub $])
+
=head2 *METHOD $component / / had_exit / 2.0b6 / no
+True if the exit was called during the excution of the component.
+
=head2 *METHOD $component / / path_ndx / 2.0b6 / no
+Tells Embperl how much parts of the L<path> should be ignored when searching
+throught the path.
+
=head2 *METHOD $component / / cwd / 2.0b6 / no
+Directory of the source file of the component.
+
=head2 *METHOD $component / / sourcefile / 2.0b6 / no
+Source file of the component.
+
+=cut
+
=head2 *METHOD $component / / buf / 2.0b6 / no
=head2 *METHOD $component / / end_pos / 2.0b6 / no
@@ -1469,20 +1612,43 @@
=head2 *METHOD $component / / source_dom_tree / 2.0b6 / no
-=head2 *METHOD $component / / syntax / 2.0b6 / no
+=pod
+
+=head2 *METHOD $component / / syntax / 2.0b6 / yes, before execution
+
+Syntax of the component
+
+=cut
=head2 *METHOD $component / / append_to_main_req / 2.0b6 / no
+=pod
+
=head2 *METHOD $component / / prev / 2.0b6 / no
+Previous component, e.g. the component which called this component.
+
+=cut
+
=head2 *METHOD $component / / strict / 2.0b6 / no
+=pod
+
=head2 *METHOD $component / / import_stash / 2.0b6 / no
-=head2 *METHOD $component / / exports / 2.0b6 / no
+While importing a component this is set to the stash to which symbols are imported.
+C<undef> during normal execution.
+
+=head2 *METHOD $component / / exports / 2.0b6 / yes
+
+Symbols that should be exported by this component.
=head2 *METHOD $component / / curr_package / 2.0b6 / no
+Name of the package the component is executed in.
+
+=cut
+
=head2 *METHOD $component / / eval_package / 2.0b6 / no
=head2 *METHOD $component / / main_sub / 2.0b6 / no
@@ -1493,4 +1659,11 @@
=head2 *METHOD $component / / prog_def / 2.0b6 / no
-=head2 *METHOD $component / / code / 2.0b6 / no
+=pod
+
+=head2 *METHOD $component / / code / 2.0b6 / yes
+
+Only valid during compile phase. Can used to retrive and modify the code
+Embperl is generating. See Embperl::Syntax for more details and Embperl::Syntax::RTF
+for an example.
+
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
