view release on metacpan or  search on metacpan

lib/CGI/Framework.pm  view on Meta::CPAN

	# And now some initialization
	#
	$self->{action}              = $para{action};
	$self->{valid_languages}     = $para{valid_languages};
	$self->{templates_dir}       = $para{templates_dir};
	$self->{initial_template}    = $para{initial_template};
	$self->{callbacks_namespace} = $para{callbacks_namespace};
	$self->{log_filename}        = $para{log_filename};
	$self->{disable_back_button} = $para{disable_back_button};
	$self->{output_filter}       = $para{output_filter};
	$self->{_cgi}                = new CGI || die "Failed to create a new CGI instance: $! $@\n";
	$cookie_value = $self->{_cgi}->cookie($para{cookie_name}) || undef;

	if ($para{"maketext_class_name"}) {
		undef $@;
		eval { eval("require $para{'maketext_class_name'};") || die "Failed to require() $para{'maketext_class_name'}: $! $@"; };
		if ($@) {
			croak "Could not properly initialize maketext_class_name ($para{'maketext_class_name'}): $@";
		}
		else {
			$self->{maketext_class_name} = $para{"maketext_class_name"};
		}
	}

	#
	# Initialize session object
	#
	if ($para{sessions_dir}) {
		$sessions_driver = "File";
	}
	else {
		$sessions_driver = "MySQL";
	}
	if ($para{sessions_serializer_storable}) {
		$sessions_serializer = "Storable";
	}
	elsif ($para{sessions_serializer_freezethaw}) {
		$sessions_serializer = "FreezeThaw";
	}
	else {
		$sessions_serializer = "Default";
	}
	$self->{_session} = new CGI::Session(
		"driver:$sessions_driver;serializer:$sessions_serializer",
		$cookie_value,
		{
			Handle    => $para{sessions_mysql_dbh},
			Directory => $para{sessions_dir},
		}
	  )
	  || die "Failed to create new CGI::Session instance with $sessions_driver - based storage and $sessions_serializer - based serialization: $! $@\n";

	if ($para{"import_form"}) {
		$self->{_cgi}->import_names($para{"import_form"});
		$self->{_import_form} = $para{"import_form"};
	}

	if (!$cookie_value || ($self->{_session}->id() ne $cookie_value)) {

		# We just created a new session - send it to the user
		print "Set-Cookie: $para{cookie_name}=", $self->{_session}->id(), ($para{cookie_domain} ? "; domain=" . $para{cookie_domain} : ""), "\n";
	}
	$expire = $para{"expire"} ? ($para{"expire"} =~ /[^0-9]/ ? $para{"expire"} : "+$para{expire}m") : "+15m";
	$self->{_session}->expire($expire);

	#
	# Language handling
	#
	if ($self->{_cgi}->param("_lang") && scalar @{ $self->{valid_languages} }) {
		if (grep { $self->{_cgi}->param("_lang") eq $_ } @{ $self->{valid_languages} }) {

			#
			# Override session language
			#
			$self->{_session}->param("_lang", scalar $self->{_cgi}->param("_lang"));
		}
		else {
			print "Content-type: text/plain\n\n";
			print "Unsupported language\n";
			$self->finalize();
		}
	}
	elsif (scalar @{ $self->{valid_languages} } && !$self->{_session}->param("_lang")) {

		# Set default language
		$self->{_session}->param("_lang", $self->{valid_languages}->[0]);
	}

	#
	# We're done initializing !
	#
	$LASTINSTANCE = $self;
	return ($self);
}

#
# Takes a scalar key
# Copies that key from the form to the session
#
sub remember {
	my $self           = _getself(\@_);
	my $sourcekey      = shift || croak "key not supplied";
	my $destinationkey = shift || $sourcekey;
	$self->session($destinationkey, $self->form($sourcekey));
}

#
# Takes a template name
# returns scalar output string containing parsed template, with lang and tags substitution
# In array mode also returns a second element which is the content-type
#
sub return_template {
	my $self = _getself(\@_);
	my $template_name = shift || croak "Template name not supplied";
	my $template;
	my $content_type;
	my $filename;
	my $output;
	my ($key, $value);
	my $temp;
	my $header;