CGI-Auth-Basic
view release on metacpan or search on metacpan
lib/CGI/Auth/Basic.pm view on Meta::CPAN
# For form errors
sub _error {
my $self = shift;
my $error = shift;
return $self->_screen(
content => qq~<span class="error">$error</span>~,
title => $self->_get_title('error'),
);
}
sub _screen {
my($self, @args) = @_;
my %p = @args % 2 ? () : @args;
my @cookie = $p{cookie} ? (-cookie => $p{cookie}) : ();
my $refresh_url;
if ( $self->{hidden_q} ) {
$refresh_url = "$self->{program}?$self->{hidden_q}";
}
else {
my @qs;
foreach my $p ( $self->{cgi}->param ) {
next if $p eq $self->{logoff_param}
|| $p eq $self->{changep_param}
|| $p eq $self->{cookie_id}
|| $p eq $self->{cookie_id} . '_new';
push @qs, $p . q{=} . $self->{cgi}->param( $p );
}
my $url = $self->{program};
if ( @qs ) {
$url =~ s{\?}{}xmsg;
$url .= q{?} . join q{&}, @qs;
}
$refresh_url = $url;
}
# Set template vars
$self->{page_logoff_link} = $self->logoff_link;
$self->{page_content} = $p{content};
$self->{page_title} = $p{title};
$self->{page_refresh} = $p{forward}
? qq~<meta http-equiv="refresh" content="0; url=$refresh_url">~
: EMPTY_STRING
;
$self->{page_inline_refresh} = $p{forward}
? qq~<a href="$refresh_url">»</a>~
: EMPTY_STRING
;
my $out = $self->_compile_template('screen') || <<"MAIN_TEMPLATE";
<html>
<head>
$self->{page_refresh}
<title>$self->{page_title}</title>
<style>
body {font-family: Verdana, sans; font-size: 10pt}
td {font-family: Verdana, sans; font-size: 10pt}
.darktable { background: black; }
.lighttable { background: white; }
.titletable { background: #dedede; }
.error { color = red; font-weight: bold}
.small { font-size: 8pt}
</style>
</head>
<body>
$self->{'page_logoff_link'}
$self->{'page_content'}
$self->{'page_inline_refresh'}
</body>
</html>
MAIN_TEMPLATE
my $header = $self->{cgi}->header(
-charset => $self->{http_charset},
@cookie
);
my $pok = print $header . $out;
return $self->_exit_program;
}
sub fatal_header {
my($self, @args) = @_;
$FATAL_HEADER = shift @args if @args;
return $FATAL_HEADER || qq~Content-Type: text/html; charset=ISO-8859-1\n\n~;
}
# Trap deadly errors
sub _fatal {
my $self = shift;
my $error = shift || EMPTY_STRING;
my @rep = caller 0;
my @caller = caller 1;
$rep[1] =~ s{.*[\\/]}{}xms;
$caller[1] =~ s{.*[\\/]}{}xms;
my $class = ref $self;
my $version = $self->VERSION;
my $fatal = $self->fatal_header;
$fatal .= <<"FATAL";
<html>
<head>
<title>Flawless Victory</title>
<style>
body {font-family: Verdana, sans; font-size: 11pt}
.error { color : red }
.finfo { color : gray}
</style>
</head>
<body>
<h1>$class $version - Fatal Error</h1>
<span class="error">$error</span>
<br>
<br>
<span class="finfo">Program terminated at <b>$caller[1]</b>
(package <b>$caller[0]</b>) line <b>$caller[2]</b>.
<br>
Error occurred in <b>$rep[0]</b> line <b>$rep[2]</b>.
</span>
</body>
</html>
FATAL
my $pok = print $fatal;
return $self->_exit_program;
( run in 0.852 second using v1.01-cache-2.11-cpan-39bf76dae61 )