home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / Example.pm < prev    next >
Encoding:
Perl POD Document  |  2003-03-14  |  4.5 KB  |  204 lines
  1. package CGI::Session::Example;
  2.  
  3. # $Id: Example.pm,v 1.1.2.2 2003/03/14 13:17:38 sherzodr Exp $
  4.  
  5. use strict;
  6. #use diagnostics;
  7. use File::Spec;
  8. use base 'CGI::Application';
  9.  
  10.  
  11. # look into CGI::Application for the details of setup() method
  12. sub setup {
  13.   my $self = shift;
  14.  
  15.   $self->mode_param(\&parsePathInfo);  
  16.   $self->run_modes(
  17.     start => 'default',
  18.     default => 'default',
  19.     'dump-session' => \&dump_session,
  20.     'params'  => \&display_params,
  21.   );
  22.  
  23.   # setting up default HTTP header. See the details of query() and
  24.   # header_props() methods in CGI::Application manpage
  25.   my $cgi = $self->query();
  26.   my $session = $self->session();
  27.   my $sid_cookie = $cgi->cookie($session->name(), $session->id());
  28.   $self->header_props(-type=>'text/html', -cookie=>$sid_cookie);
  29. }
  30.  
  31.  
  32.  
  33.  
  34.  
  35. # this method simply returns CGI::Session object.
  36. sub session {
  37.   my $self = shift;
  38.  
  39.   if ( defined $self->param("_SESSION") ) {
  40.     return $self->param("_SESSION");
  41.   }
  42.   require CGI::Session;
  43.   my $dsn = $self->param("_SESSION_DSN") || undef;
  44.   my $options = $self->param("_SESSION_OPTIONS") || {Directory=>File::Spec->tmpdir    };
  45.   my $session = CGI::Session->new($dsn, $self->query, $options);  
  46.   unless ( defined $session ) {
  47.     die CGI::Session->error();
  48.   }  
  49.   $self->param(_SESSION => $session);
  50.   return $self->session();
  51. }
  52.  
  53. # parses PATH_INFO and retrieves a portion which defines a run-mode
  54. # to be executed to display the current page. Refer to CGI::Application
  55. # manpage for details of run-modes and mode_param() method
  56. sub parsePathInfo {
  57.   my $self = shift;
  58.  
  59.   unless ( defined $ENV{PATH_INFO} ) {
  60.     return;
  61.   }
  62.   my ($cmd) = $ENV{PATH_INFO} =~ m!/cmd/-/([^?]+)!;
  63.   return $cmd;
  64. }
  65.  
  66.  
  67. # see CGI::Application manpage
  68. sub teardown {
  69.   my $self = shift;
  70.  
  71.   my $session = $self->param("_SESSION");
  72.   if ( defined $session ) {
  73.     $session->close();
  74.   }
  75. }
  76.  
  77.  
  78.  
  79.  
  80.  
  81. # overriding CGI::Application's load_tmpl() method. It doesn't
  82. # return an HTML object, but the contents of the HTML template
  83. sub load_tmpl {
  84.   my ($self, $filename, $args) = @_;
  85.  
  86.   # defining a default param set for the templates
  87.   $args ||= {};
  88.   my $cgi     = $self->query();
  89.   my $session = $self->session();
  90.   # making all the %ENV variables available for all the templates
  91.   map { $args->{$_} = $ENV{$_} } keys %ENV;  
  92.   # making session  id available for all the templates
  93.   $args->{ $session->name() } = $session->id;
  94.   # making library's version available for all the templates
  95.   $args->{ VERSION } = $session->version();
  96.  
  97.   # loading the template
  98.   require HTML::Template;
  99.   my $t = new HTML::Template(filename                    => $filename,
  100.                              associate                   => [$session, $cgi],
  101.                              vanguard_compatibility_mode => 1);
  102.   $t->param(%$args);
  103.   return $t->output();
  104. }
  105.  
  106.  
  107.  
  108. sub urlf {
  109.   my ($self, $cmd) = @_;
  110.  
  111.   my $sid = $self->session()->id;
  112.   my $name = $self->session()->name;
  113.  
  114.   return sprintf("$ENV{SCRIPT_NAME}/cmd/-/%s?%s=%s", $cmd, $name, $sid);
  115. }
  116.  
  117.  
  118.  
  119. sub page {
  120.   my ($self, $body) = @_;
  121.  
  122.   my %params = (
  123.     body        => $body,
  124.     url_default => $self->urlf('default'),
  125.     url_dump    => $self->urlf('dump-session'),
  126.     url_params  => $self->urlf('params'),
  127.   );
  128.   return $self->load_tmpl('page.html', \%params);
  129. }
  130.  
  131.  
  132.  
  133.  
  134. # Application methods
  135. sub default {
  136.   my $self = shift;
  137.  
  138.   my $session = $self->session();
  139.  
  140.   my $body = $self->load_tmpl('welcome.html');
  141.   
  142.   return $self->page($body);
  143. }
  144.  
  145.  
  146. sub dump_session {
  147.     my $self = shift;
  148.  
  149.     my $dmp = $self->session()->dump(undef, 1);
  150.     return $self->page(sprintf "<pre>%s</pre>", $dmp );
  151. }
  152.  
  153.  
  154. sub delete_session {
  155.     my $self = shift;
  156.  
  157.     $self->session()->delete();
  158.     $self->header_type('redirect');
  159.     $self->header_props(-uri=>$ENV{HTTP_REFERER});
  160. }
  161.  
  162.  
  163. sub display_params {
  164.     my $self = shift;
  165.  
  166.     my $session = $self->session();
  167.     my @list = ();
  168.     for my $name ( $session->param() ) {
  169.         $name =~ /^_SESSION_/ and next;
  170.         my $value = $session->param($_);
  171.         push @list, {name => $name, value=>$value};
  172.     }
  173.     my %params = (
  174.         list => \@list,
  175.     );
  176.     my $body = $self->load_tmpl('display-params.html', \%params);
  177.     return $self->page($body);
  178. }
  179.         
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  
  189. 1;
  190.  
  191. __END__
  192. # Below is stub documentation for your module. You'd better edit it!
  193.  
  194. =head1 NAME
  195.  
  196. CGI::Session::Example - Example on using CGI::Session
  197.  
  198. =head1 DESCRIPTION
  199.  
  200. STILL NOT COMPLETED. CHECK BACK FOR THE NEXT RELEASE OF CGI::Session.
  201.  
  202.  
  203.  
  204.