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...@locus.apache.org on 2000/09/07 22:14:17 UTC
cvs commit: embperl/test/html/registry reggetsess.htm
richter 00/09/07 13:14:16
Modified: . Changes.pod Embperl.pm Embperl.pod EmbperlD.pod
MANIFEST epmain.c test.pl
Added: test/cmp delsess.htm getdelsess.htm reggetsess.htm
test/html delsess.htm getdelsess.htm
test/html/registry reggetsess.htm
Log:
- Added access to Embperl session handling for modules and
calling scripts (see SetupSession and GetSession)
- Added method for deleting session data and cookie
- Added method for triggering resend of session cookie.
Revision Changes Path
1.127 +4 -0 embperl/Changes.pod
Index: Changes.pod
===================================================================
RCS file: /home/cvs/embperl/Changes.pod,v
retrieving revision 1.126
retrieving revision 1.127
diff -u -r1.126 -r1.127
--- Changes.pod 2000/08/24 05:43:39 1.126
+++ Changes.pod 2000/09/07 20:13:49 1.127
@@ -15,6 +15,10 @@
- Fixed a problem with importing files that contains foreach and
do until loops, which may caused a syntax error or endless
loop. Spotted by Steffen Geschke.
+ - Added access to Embperl session handling for modules and
+ calling scripts (see SetupSession and GetSession)
+ - Added method for deleting session data and cookie
+ - Added method for triggering resend of session cookie.
=head1 1.3b5 (BETA) 20. Aug 2000
1.116 +2 -1 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.115
retrieving revision 1.116
diff -u -r1.115 -r1.116
--- Embperl.pm 2000/09/06 06:24:36 1.115
+++ Embperl.pm 2000/09/07 20:13:50 1.116
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Embperl.pm,v 1.115 2000/09/06 06:24:36 richter Exp $
+# $Id: Embperl.pm,v 1.116 2000/09/07 20:13:50 richter Exp $
#
###################################################################################
@@ -1645,8 +1645,9 @@
{
my $r = shift || HTML::Embperl::CurrReq () ;
+ my $disabledelete = shift ;
- tied(%HTML::Embperl::udat) -> delete ; # Delete session data
+ tied(%HTML::Embperl::udat) -> delete if (!$disabledelete) ; # Delete session data
$r -> SessionMgnt (-1) ; # resend cookie without value
}
1.55 +44 -0 embperl/Embperl.pod
Index: Embperl.pod
===================================================================
RCS file: /home/cvs/embperl/Embperl.pod,v
retrieving revision 1.54
retrieving revision 1.55
diff -u -r1.54 -r1.55
--- Embperl.pod 2000/08/24 05:43:39 1.54
+++ Embperl.pod 2000/09/07 20:13:52 1.55
@@ -1944,6 +1944,50 @@
When you store data to %mdat Embperl will store the data via Apache::Session and retrieves it
when the next request comes to the same page.
+
+=head2 Functions/Methods for session handling
+
+=head2 HTML::Embperl::Req::SetupSession ($req_rec, $Inputfile)
+
+This can be used from an script that will later on call L<HTML::Embperl::Execute|Execute> to
+preset the session so it's available to the calling script.
+
+=over 4
+
+=item $req_rec
+
+Apache request record when running under mod_perl, C<undef> otherwise.
+
+=item $Inputfile
+
+Name of file that will be process later by Embperl. It is used to setup L<%mdat>. If you
+don't pass the C<$Inputfile>, C<%mdat> is not setup.
+
+=back
+
+Returns a reference to L<%udat> or, if call in an array context, a reference to L<%udat>
+and L<%mdat>.
+
+=head2 HTML::Embperl::Req::GetSession / $r -> GetSession
+
+Returns a reference to L<%udat> or, if call in an array context, a reference to L<%udat>
+and L<%mdat>. This could be used by modules that are called from inside a Embperl page,
+where the session management is already setup. If called as a method C<$r> must be
+a HTML::Embperl::Req object, which is passed as first parameter to every Embperl page in @_ .
+
+=head2 HTML::Embperl::Req::DeleteSession / $r -> DeleteSession
+
+Deletes the session data and removes the cookie from the browser.
+If called as a method C<$r> must be
+a HTML::Embperl::Req object, which is passed as first parameter to every Embperl page in @_ .
+
+=head2 HTML::Embperl::Req::DeleteSession / $r -> DeleteSession
+
+Triggers a resend of the cookie. Normaly the cookie is only send the first time.
+If called as a method C<$r> must be
+a HTML::Embperl::Req object, which is passed as first parameter to every Embperl page in @_ .
+
+
=head1 (Safe-)Namespaces and opcode restrictions
Since most web servers will contain more than one document, it is
1.28 +46 -0 embperl/EmbperlD.pod
Index: EmbperlD.pod
===================================================================
RCS file: /home/cvs/embperl/EmbperlD.pod,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -r1.27 -r1.28
--- EmbperlD.pod 2000/08/24 05:43:39 1.27
+++ EmbperlD.pod 2000/09/07 20:13:52 1.28
@@ -1850,6 +1850,52 @@
werden die Daten f�r C<%mdat> erst von I<Apache::Session> angefordert, wenn
auf diesen Hash zugegriffen wird.
+=head2 Funktionen/Methoden f�rs Session Handling
+
+=head2 HTML::Embperl::Req::SetupSession ($req_rec, $Inputfile)
+
+Diese Funktion kann von Skripten benutzt werden die in ihrem Verlauf
+L<HTML::Embperl::Execute|Execute> aufrufen, jedoch vorher schon auf die Sessiondaten
+von Embperl zugreifen wollen.
+
+=over 4
+
+=item $req_rec
+
+Apache request record soweit das Skript unter I<mod_perl> l�uft, ansonsten C<undef>.
+
+=item $Inputfile
+
+Name der Datei die sp�ter von I<Embperl> bearbeitet werden soll. Dient dazu L<%mdat> zu
+initialsieren. Wird C<%mdat> nicht ben�tigt, kann dieser Parameter weggelassen werden.
+
+=back
+
+Liefert eine Referenz auf L<%udat> oder, wenn es in einem Arraykontext aufgerufen wird,
+eine Referenz auf L<%udat> und L<%mdat> zur�ck.
+
+=head2 HTML::Embperl::Req::GetSession / $r -> GetSession
+
+Liefert eine Referenz auf L<%udat> oder, wenn es in einem Arraykontext aufgerufen wird,
+eine Referenz auf L<%udat> und L<%mdat> zur�ck.
+Dies Funktion kann benutzt werden um auf die Embperl Sessiondaten aus einem Modul
+zuzugreifen, wenn das Session Handling bereits initialisiert ist.
+Wenn es als eine Methode aufgerufen wird mu� C<$r> ein C<HTML::Embperl::Req> Objekt sein.
+Dieses wird als erster Parameter in @_ an jede Seite �bergeben.
+
+=head2 HTML::Embperl::Req::DeleteSession / $r -> DeleteSession
+
+L�scht die Sessiondaten und entfernt den Cookie vom Browser.
+Wenn es als eine Methode aufgerufen wird mu� C<$r> ein C<HTML::Embperl::Req> Objekt sein.
+Dieses wird als erster Parameter in @_ an jede Seite �bergeben.
+
+=head2 HTML::Embperl::Req::DeleteSession / $r -> DeleteSession
+
+St��t das nochmalige senden des Cookies an. Normalerweise wird der Cookie nur beim ersten
+Mal gesendet.
+Wenn es als eine Methode aufgerufen wird mu� C<$r> ein C<HTML::Embperl::Req> Objekt sein.
+Dieses wird als erster Parameter in @_ an jede Seite �bergeben.
+
=head1 (Sichere-)Namensr�ume und Opcode Restriktionen
1.49 +6 -0 embperl/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /home/cvs/embperl/MANIFEST,v
retrieving revision 1.48
retrieving revision 1.49
diff -u -r1.48 -r1.49
--- MANIFEST 2000/08/24 06:03:47 1.48
+++ MANIFEST 2000/09/07 20:13:53 1.49
@@ -133,6 +133,9 @@
test/html/mdatsess.htm
test/html/execgetsess.htm
test/html/clearsess.htm
+test/html/delsess.htm
+test/html/getdelsess.htm
+test/html/registry/reggetsess.htm
test/html/EmbperlObject/epobase.htm
test/html/EmbperlObject/epohead.htm
test/html/EmbperlObject/epofoot.htm
@@ -218,6 +221,9 @@
test/cmp/getnosess.htm
test/cmp/mdatsess.htm
test/cmp/execgetsess.htm
+test/cmp/delsess.htm
+test/cmp/getdelsess.htm
+test/cmp/registry/reggetsess.htm
test/cmp/errdoc.htm
test/cmp/errdoc2.htm
test/cmp/clearsess.htm
1.73 +7 -2 embperl/epmain.c
Index: epmain.c
===================================================================
RCS file: /home/cvs/embperl/epmain.c,v
retrieving revision 1.72
retrieving revision 1.73
diff -u -r1.72 -r1.73
--- epmain.c 2000/09/06 06:24:36 1.72
+++ epmain.c 2000/09/07 20:13:54 1.73
@@ -2291,6 +2291,7 @@
SV * pOut = NULL ;
int bOutToMem = SvROK (pOutData) ;
SV * pCookie = NULL ;
+ STRLEN ldummy ;
if (rc != ok || r -> bError)
{ /* --- generate error page if necessary --- */
@@ -2356,6 +2357,8 @@
r -> pConf -> sCookieDomain[0]?"; domain=":"" , r -> pConf -> sCookieDomain,
r -> pConf -> sCookiePath[0]?"; path=":"" , r -> pConf -> sCookiePath) ;
+ if (r -> bDebug & dbgSession)
+ lprintf (r, "[%d]SES: Delete Cookie -> %s\n", r -> nPid, SvPV(pCookie, ldummy)) ;
}
else if (r -> nSessionMgnt == 2)
{
@@ -2392,6 +2395,8 @@
r -> pConf -> sCookieDomain[0]?"; domain=":"" , r -> pConf -> sCookieDomain,
r -> pConf -> sCookiePath[0]?"; path=":"" , r -> pConf -> sCookiePath,
r -> pConf -> sCookieExpires[0]?"; expires=":"", r -> pConf -> sCookieExpires) ;
+ if (r -> bDebug & dbgSession)
+ lprintf (r, "[%d]SES: Send Cookie -> %s\n", r -> nPid, SvPV(pCookie, ldummy)) ;
}
}
@@ -2413,7 +2418,7 @@
if (pHeader && pKey)
{
- p = SvPV (pHeader, na) ;
+ p = SvPV (pHeader, ldummy) ;
if (strnicmp (pKey, "location", 8) == 0)
r -> pApacheReq->status = 301;
if (strnicmp (pKey, "content-type", 12) == 0)
@@ -2424,7 +2429,7 @@
}
if (pCookie)
{
- table_add(r -> pApacheReq->headers_out, sSetCookie, pstrdup(r -> pApacheReq->pool, SvPV(pCookie, na))) ;
+ table_add(r -> pApacheReq->headers_out, sSetCookie, pstrdup(r -> pApacheReq->pool, SvPV(pCookie, ldummy))) ;
SvREFCNT_dec (pCookie) ;
}
set_content_length (r -> pApacheReq, GetContentLength (r) + 2) ;
1.69 +4 -1 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.68
retrieving revision 1.69
diff -u -r1.68 -r1.69
--- test.pl 2000/09/06 06:24:36 1.68
+++ test.pl 2000/09/07 20:13:55 1.69
@@ -94,8 +94,10 @@
'getsess.htm',
'mdatsess.htm?cnt=3',
'execgetsess.htm',
- 'delsess.htm',
+ 'registry/reggetsess.htm',
'getsess.htm',
+ 'delsess.htm',
+ 'getdelsess.htm',
'clearsess.htm',
'EmbperlObject/epopage1.htm',
'EmbperlObject/epodiv.htm',
@@ -571,6 +573,7 @@
my $c = $response -> header ('Set-Cookie') || '' ;
$cookie = $c if (!$cookie && ($c =~ /EMBPERL_UID/)) ;
+ $cookie = undef if (($c =~ /EMBPERL_UID=;/)) ;
#print "Got Cookie $cookie\n" ;
#print $response -> headers -> as_string () ;
1.1 embperl/test/cmp/delsess.htm
Index: delsess.htm
===================================================================
<html>
<head>
<title>Tests for Embperl - Delete Session Data</title>
</head>
<body>
udat before:<br>
<table>
<tr>
<td>a</td><td>1</td>
</tr>
</table>
ok (num=1)<p>
$mdat{cnt} = -- <br>
$udat{cnt} = -- <br>
udat after:<br>
<table>
<tr>
<td>a</td><td>1</td>
</tr>
</table>
ok (num=1)<p>
</body>
</html>
1.1 embperl/test/cmp/getdelsess.htm
Index: getdelsess.htm
===================================================================
<html>
<head>
<title>Tests for Embperl - Set Session Data</title>
</head>
<body>
fdat:<br>
<table></table>
udat:<br>
<table></table>
Not a session hash (num=0)<p>
$mdat{cnt} = -- <br>
$udat{cnt} = -- <br>
sessions:
<table></table>
</body>
</html>
1.1 embperl/test/cmp/reggetsess.htm
Index: reggetsess.htm
===================================================================
<HTML><TITLE>Test for HTML::Embperl::Req::SetupSession</TITLE><BODY>
a = 1 <BR>
<P>Here is some text inside of Execute</P>
</BODY></HTML>
1.1 embperl/test/html/delsess.htm
Index: delsess.htm
===================================================================
<html>
<head>
<title>Tests for Embperl - Delete Session Data</title>
</head>
<body>
udat before:<br>
[- @ks = grep (!/^_/, sort (keys %udat)) ; $num = keys (%udat) - $#ks - 1 ; -]
<table>
<tr>
<td>[+ $ks[$row] +]</td><td>[+ $udat{$ks[$row] || ''} +]</td>
</tr>
</table>
[+ $num > 0?"ok (num=$num)":"Not a session hash (num=$num)" +]<p>
$mdat{cnt} = -[+ $mdat{cnt} ; +]- <br>
$udat{cnt} = -[+ $udat{cnt} ; +]- <br>
[- HTML::Embperl::Req::DeleteSession (undef, 1) ; -]
udat after:<br>
[- @ks = grep (!/^_/, sort (keys %udat)) ; $num = keys (%udat) - $#ks - 1 ; -]
<table>
<tr>
<td>[+ $ks[$row] +]</td><td>[+ $udat{$ks[$row] || ''} +]</td>
</tr>
</table>
[+ $num > 0?"ok (num=$num)":"Not a session hash (num=$num)" +]<p>
</body>
</html>
1.1 embperl/test/html/getdelsess.htm
Index: getdelsess.htm
===================================================================
<html>
<head>
<title>Tests for Embperl - Set Session Data</title>
</head>
<body>
fdat:<br>
[- @ks = sort keys %fdat -]
<table>
<tr>
<td>[+ $ks[$row] +]</td><td>[+ $fdat{$ks[$row] || ''} +]</td>
</tr>
</table>
udat:<br>
[- $off = 0 ; $off-- if ($HTML::Embperl::SessionMgnt == 2 && !defined (tied (%udat) -> getid)) ; -]
[- @ks = grep (!/^_/, sort (keys %udat)) ; $num = keys (%udat) - $#ks - 1 + $off ; -]
<table>
<tr>
<td>[+ $ks[$row] +]</td><td>[+ $udat{$ks[$row] || ''} +]</td>
</tr>
</table>
[+ $num > 0?"ok (num=$num)":"Not a session hash (num=$num)" +]<p>
[-
while (($k, $v) = each (%fdat))
{
$udat{$k} = $fdat{$k} ;
}
-]
$mdat{cnt} = -[+ $mdat{cnt} ; +]- <br>
$udat{cnt} = -[+ $udat{cnt} ; +]- <br>
[- $s = $Apache::Session::Win32::sessions || $Apache::Session::MemoryStore::store -]
[- @ks = sort keys %$s -]
sessions:
<table>
<tr>
<td>[+ $ks[$row] +]</td><td>[+ $s -> {$ks[$row] || ''} +]</td>
</tr>
</table>
</body>
</html>
1.1 embperl/test/html/registry/reggetsess.htm
Index: reggetsess.htm
===================================================================
#
# run this under mod_perl / Apache::Registry
#
use HTML::Embperl ;
my($r) = @_;
$HTML::Embperl::DebugDefault = 811005 ;
$r -> status (200) ;
$r -> send_http_header () ;
print "<HTML><TITLE>Test for HTML::Embperl::Req::SetupSession</TITLE><BODY>\n" ;
my $session = HTML::Embperl::Req::SetupSession ($r) ;
$off = 0 ; $off-- if ($HTML::Embperl::SessionMgnt == 2 && !defined (tied (%$session) -> getid)) ;
@ks = grep (!/^_/, sort (keys %$session)) ; $num = keys (%$session) - $#ks - 1 + $off ;
foreach (@ks)
{
print "$_ = $session->{$_} <BR>\n" ;
}
$tst1 = '<P>Here is some text inside of Execute</P>' ;
HTML::Embperl::Execute ({input => \$tst1,
mtime => 1,
inputfile => 'Some text',
}) ;
print "</BODY></HTML>\n" ;