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" ;
  
  
  

---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]

Reply via email to