1   #!/usr/bin/perl
2   use strict;
3   $|++;
4 
5   use DBI ();
6   use CGI::Pretty qw(:all -no_debug);
7 
8   ## BEGIN CONFIG ##
9 
10  my $DSN = 'dbi:mysql:stonehenge_httpd';
11  my $DB_AUTH = 'sekretuser:sekretpassword';
12  my $OUTPUT = "/home/merlyn/Html/stats.html";
13  my $DAY = 7;
14  my $COMMON = <<END_COMMON;
15  (
16  (
17  Url not like '/%/%'
18  or Url like '/perltraining/%'
19  or Url like '/merlyn/%'
20  or Url like '/cgi/%'
21  or Url like '/perl/%'
22  or Url like '/icons/%'
23  or Url like '/books/%'
24  )
25  and Host not like '%.stonehenge.%'
26  and When > date_sub(now(), interval $DAY day)
27  )
28  END_COMMON
29 
30  ## END CONFIG ##
31 
32  my $TMP = "$OUTPUT~NEW~";
33  open STDOUT, ">$TMP" or die "Cannot create $TMP: $!";
34  chmod 0644, $TMP or warn "Cannot chmod $TMP: $!";
35 
36  my $dbh = DBI->connect($DSN, (split ':', $DB_AUTH), 
              { RaiseError => 1 });
37  $dbh->do("SET OPTION SQL_BIG_TABLES = 1");
38 
39  print
40  start_html("Web server activity"),
41  h1("Web server activity at ".localtime),
42  p("This page gives web server activity viewed in various ways,",
43  "updated frequently for information over the prior seven days.");
44 
45  print
46  h2("Incoming links"),
47  p("The following links were the most frequent ways that people found to  this site.");
48 
49  print
50  table({Cellspacing => 0, Cellpadding => 2, Border => 1},
51  Tr(
52  th("Hits in<br>past $DAY days"),
53  th("Source of link"),
54  th("Target of link"),
55  ),
56  map {
57  my ($hits, $referer, $url)  @$_;
58  Tr(
59  td($hits),
60  td(show_link($referer)),
61  td(show_link($url)),
62  );
63  } @{$dbh->selectall_arrayref(<<END)});
64  select count(*) as Hits, Referer, Url
65  from requests
66  where $COMMON and Referer not like '%.stonehenge.%'
67  group by Referer, Url
68  order by Hits desc
69  limit 30
70  END
71 
72  print
73  h2("Outgoing links"),
74  p("The following links were the most frequent ways that people 
       left this site.");
75 
76  print
77  table({Cellspacing => 0, Cellpadding => 2, Border => 1},
78  Tr(
79  th("Hits in<br>past $DAY days"),
80  th("Source of link"),
81  th("Target of link"),
82  ),
83  map {
84  my ($hits, $referer, $url) = @$_;
85  $url =~ s#^/cgi/go/##;
86  Tr(
87  td($hits),
88  td(show_link($referer)),
89  td(show_link($url)),
90  );
91  } @{$dbh->selectall_arrayref(<<END)});
92  select count(*) as Hits, Referer, Url
93  from requests
94  where $COMMON and Url like '/cgi/go/%'
95  group by Referer, Url
96  order by Hits desc
97  limit 30
98  END
99 
100 print
101 h2("CPU Burning"),
102 p("The following hosts burnt the most cumulative CPU 
       on the server.");
103 
104 print
105 table({Cellspacing => 0, Cellpadding => 2, Border => 1},
106 Tr(
107 th("Total CPU seconds<br>in past $DAY days"),
108 th("Host making the request"),
109 ),
110 map {
111 my ($cpu, $host) = @$_;
112 Tr(
113 td($cpu),
114 td($host),
115 );
116 } @{$dbh->selectall_arrayref(<<END)});
117 select sum(cpuuser+cpusys+cpucuser+cpucsys) as Cpu, Host
118 from requests
119 where $COMMON
120 group by Host
121 order by Cpu desc
122 limit 30
123 END
124 
125 print
126 h2("CPU Hogging"),
127 p("The following periods were the busiest in terms of 
       total CPU used.");
128 
129 print
130 table({Cellspacing => 0, Cellpadding => 2, Border => 1},
131 Tr(
132 th("15-minute period beginning<br>(localtime)"),
133 th("Total CPU seconds<br>burnt in the period"),
134 ),
135 map {
136 my ($period, $cpu) = @$_;
137 Tr(
138 td($period),
139 td($cpu),
140 );
141 } @{$dbh->selectall_arrayref(<<END)});
142 select
143 from_unixtime(15*60*floor(unix_timestamp(when)/(15*60))) as Period,
144 sum(cpuuser+cpusys+cpucuser+cpucsys) as Cpu
145 from requests
146 where $COMMON group by Period
147 order by Cpu desc
148 limit 30
149 END
150 
151 print
152 h2("User Agent Bytesucking"),
153 p("The following User Agents sucked the most cumulative bytes 
       on the server.");
154 
155 print
156 table({Cellspacing => 0, Cellpadding => 2, Border => 1},
157 Tr(
158 th("Total Bytes<br>in past $DAY days"),
159 th("User Agent making the request"),
160 ),
161 map {
162 my ($sent, $agent) = @$_;
163 Tr(
164 td($sent),
165 td($agent),
166 );
167 } @{$dbh->selectall_arrayref(<<END)});
168 select sum(Bytes) as Sent, Browser
169 from requests
170 where $COMMON
171 group by Browser
172 order by Sent desc
173 limit 30
174 END
175 
176 print end_html;
177 
178 $dbh->disconnect;
179 
180 close STDOUT;
181 rename $TMP, $OUTPUT or die "Cannot rename $TMP to $OUTPUT: $!";
182 
183 sub show_link {
184 use HTML::Entities ();
185 my $url = shift;
186 my $html_escaped_url = HTML::Entities::encode_entities($url);
187 a({Href => $html_escaped_url}, $html_escaped_url);
188 }