The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package CGI::Session::Example;

# $Id: Example.pm,v 1.1.2.2 2003/03/14 13:17:38 sherzodr Exp $

use strict;
#use diagnostics;
use File::Spec;
use base 'CGI::Application';


# look into CGI::Application for the details of setup() method
sub setup {
  my $self = shift;

  $self->mode_param(\&parsePathInfo);  
  $self->run_modes(
    start => 'default',
    default => 'default',
	'dump-session' => \&dump_session,
	'params'  => \&display_params,
  );

  # setting up default HTTP header. See the details of query() and
  # header_props() methods in CGI::Application manpage
  my $cgi = $self->query();
  my $session = $self->session();
  my $sid_cookie = $cgi->cookie($session->name(), $session->id());
  $self->header_props(-type=>'text/html', -cookie=>$sid_cookie);
}





# this method simply returns CGI::Session object.
sub session {
  my $self = shift;

  if ( defined $self->param("_SESSION") ) {
    return $self->param("_SESSION");
  }
  require CGI::Session;
  my $dsn = $self->param("_SESSION_DSN") || undef;
  my $options = $self->param("_SESSION_OPTIONS") || {Directory=>File::Spec->tmpdir	};
  my $session = CGI::Session->new($dsn, $self->query, $options);  
  unless ( defined $session ) {
    die CGI::Session->error();
  }  
  $self->param(_SESSION => $session);
  return $self->session();
}

# parses PATH_INFO and retrieves a portion which defines a run-mode
# to be executed to display the current page. Refer to CGI::Application
# manpage for details of run-modes and mode_param() method
sub parsePathInfo {
  my $self = shift;

  unless ( defined $ENV{PATH_INFO} ) {
    return;
  }
  my ($cmd) = $ENV{PATH_INFO} =~ m!/cmd/-/([^?]+)!;
  return $cmd;
}


# see CGI::Application manpage
sub teardown {
  my $self = shift;

  my $session = $self->param("_SESSION");
  if ( defined $session ) {
    $session->close();
  }
}





# overriding CGI::Application's load_tmpl() method. It doesn't
# return an HTML object, but the contents of the HTML template
sub load_tmpl {
  my ($self, $filename, $args) = @_;

  # defining a default param set for the templates
  $args ||= {};
  my $cgi     = $self->query();
  my $session = $self->session();
  # making all the %ENV variables available for all the templates
  map { $args->{$_} = $ENV{$_} } keys %ENV;  
  # making session  id available for all the templates
  $args->{ $session->name() } = $session->id;
  # making library's version available for all the templates
  $args->{ VERSION } = $session->version();

  # loading the template
  require HTML::Template;
  my $t = new HTML::Template(filename                    => $filename,
                             associate                   => [$session, $cgi],
                             vanguard_compatibility_mode => 1);
  $t->param(%$args);
  return $t->output();
}



sub urlf {
  my ($self, $cmd) = @_;

  my $sid = $self->session()->id;
  my $name = $self->session()->name;

  return sprintf("$ENV{SCRIPT_NAME}/cmd/-/%s?%s=%s", $cmd, $name, $sid);
}



sub page {
  my ($self, $body) = @_;

  my %params = (
    body        => $body,
    url_default => $self->urlf('default'),
    url_dump    => $self->urlf('dump-session'),
	url_params  => $self->urlf('params'),
  );
  return $self->load_tmpl('page.html', \%params);
}




# Application methods
sub default {
  my $self = shift;

  my $session = $self->session();

  my $body = $self->load_tmpl('welcome.html');
  
  return $self->page($body);
}


sub dump_session {
	my $self = shift;

	my $dmp = $self->session()->dump(undef, 1);
	return $self->page(sprintf "<pre>%s</pre>", $dmp );
}


sub delete_session {
	my $self = shift;

	$self->session()->delete();
	$self->header_type('redirect');
	$self->header_props(-uri=>$ENV{HTTP_REFERER});
}


sub display_params {
	my $self = shift;

	my $session = $self->session();
	my @list = ();
	for my $name ( $session->param() ) {
		$name =~ /^_SESSION_/ and next;
		my $value = $session->param($_);
		push @list, {name => $name, value=>$value};
	}
	my %params = (
		list => \@list,
	);
	my $body = $self->load_tmpl('display-params.html', \%params);
	return $self->page($body);
}
		









1;

__END__
# Below is stub documentation for your module. You'd better edit it!

=head1 NAME

CGI::Session::Example - Example on using CGI::Session

=head1 DESCRIPTION

STILL NOT COMPLETED. CHECK BACK FOR THE NEXT RELEASE OF CGI::Session.