1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
#!/usr/bin/perl -Tw
#
# $Id: textclock.pl,v 1.8 2002/03/27 20:36:40 davorg Exp $
#
use strict;
use POSIX 'strftime';
use CGI 'header';
use vars qw($DEBUGGING $done_headers);
# Configuration
#
# $DEBUGGING must be set in a BEGIN block in order to have it be set before
# the program is fully compiled.
# This should almost certainly be set to 0 when the program is 'live'
#
BEGIN
{
$DEBUGGING = 1;
}
my $Display_Week_Day = 1;
my $Display_Month = 1;
my $Display_Month_Day = 1;
my $Display_Year = 1;
my $Display_Time = 1;
my $Display_Time_Zone = 1;
# End configuration
# We need finer control over what gets to the browser and the CGI::Carp
# set_message() is not available everywhere :(
# This is basically the same as what CGI::Carp does inside but simplified
# for our purposes here.
BEGIN
{
sub fatalsToBrowser
{
my ( $message ) = @_;
if ( $main::DEBUGGING )
{
$message =~ s/</</g;
$message =~ s/>/>/g;
}
else
{
$message = '';
}
my ( $pack, $file, $line, $sub ) = caller(1);
my ($id ) = $file =~ m%([^/]+)$%;
return undef if $file =~ /^\(eval/;
print "Content-Type: text/html\n\n" unless $done_headers;
print <<EOERR;
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>Error</title>
</head>
<body>
<h1>Application Error</h1>
<p>
An error has occurred in the program
</p>
<p>
$message
</p>
</body>
</html>
EOERR
die @_;
};
$SIG{__DIE__} = \&fatalsToBrowser;
}
my @date_fmt;
push @date_fmt, '%A' if $Display_Week_Day;
push @date_fmt, '%B' if $Display_Month;
push @date_fmt, '%d' if $Display_Month_Day;
push @date_fmt, '%Y' if $Display_Year;
push @date_fmt, '%H:%M:%S' if $Display_Time;
push @date_fmt, '%Z' if $Display_Time_Zone;
print header(-type => 'text/plain');
$done_headers++;
print strftime(join(' ', @date_fmt), localtime);
|
