in reply to Re: Re: Alternatives to PerlTransHandler?
in thread Alternatives to PerlTransHandler?
ssi-cookie.html
<HTML> <BODY> <A HREF="/cgi-bin/skin-cookie.pl">Skin this</A><BR> <!--#if expr="${HTTP_COOKIE} = /skin\=wacky/"--> wacky <!--#elif expr="${HTTP_COOKIE} = /skin\=goth/"--> goth <!--#else --> minimal <!--#endif --> </BODY> </HTML>
/cgi-bin/skin-cookie.pl
#!/usr/local/bin/perl -Tw # set 'skin' cookie then redirect where we came from use strict; use CGI; use vars qw($q $cookie $location $status @skin_names); $q = new CGI; @skin_names = qw(minimal wacky goth); main(); sub main { if (defined $q->param('skin')) { # user selected a skin my $skin_param = $q->param('skin'); for my $valid_skin (@skin_names) { if ($skin_param eq $valid_skin) { skin_cookie_page($skin_param); } } # fall through if invalid } pick_skin_page(); } sub get_old_url { return $q->param('old_url') || $q->referer() || 'http://perlmonks.org/'; } sub skin_cookie_page { my $skin_param = shift; my $cookie = $q->cookie( -name => 'skin', -value => $skin_param, -expires => '+30d', ); print $q->header(-cookie => $cookie, -status => '302 Moved', -location => get_old_url()); exit; } sub pick_skin_page { print $q->header(), $q->start_html(), # you'll want to skin this too, natural +ly :) $q->start_form(), 'Choose your skin: ', $q->popup_menu(-name => 'skin', '-values' => \@skin_names) +, $q->submit('skin'), $q->hidden('old_url' => get_old_url()), $q->end_form(), $q->end_html(); exit; }
|
|---|