+sub get_param_list ($$) {
+ my ($c) = @_;
+ my @p = ( );
+ foreach my $name ($c->param()) {
+ foreach my $val ($c->param($name)) {
+ push @p, $name, $val;
+ }
+ }
+ return @p;
+}
+
+sub get_cookie_domain ($$$) {
+ my ($c,$r) = @_;
+ my $uri = new URI $r->_ch('get_url');
+ return $uri->host();
+}
+
+sub construct_cookie ($$$) {
+ my ($c, $r, $cookv) = @_;
+ return $c->cookie(-name => $r->{S}{cookie_name},
+ -value => $cookv,
+ -path => $r->{S}{cookie_path},
+ -domain => $r->_ch('get_cookie_domain'),
+ -expires => '+'.$r->{S}{login_timeout}.'s',
+ -secure => $r->{S}{encrypted_only});
+}
+
+sub do_redirect_cgi ($$$$) {
+ my ($c, $r, $new_url, $cookie) = @_;
+ my @ha = ('text/html',
+ -status => '303 See other',
+ -location => $new_url);
+ push @ha, (-cookie => $cookie) if defined $cookie;
+ $r->_ch('print')($c->header(@ha).
+ $c->start_html('Redirection').
+ $c->a({href=>$new_url},
+ "If you aren't redirected, click to continue.").
+ $c->end_html());
+}
+