ja1200/stat/http.pl

#!/usr/bin/perl
use strict;

use Encode::Guess;

my $Version = {};
my $LastModified = {};
my $LM_duplicate = 0;
my $ContentType = {};
my $CT_duplicate = 0;
my $Server = {};
my $Server_duplicate = 0;

our $target = shift;
our $code = sub {
  my $entity = shift;
  $Version->{$entity->{protocol_version}}++;

  if ($entity->{field}->{'last-modified'}) {
    if (@{$entity->{field}->{'last-modified'}} > 1) {
      $LM_duplicate++;
    }
    my $lm = $entity->{field}->{'last-modified'}->[0];
    if ($lm =~ /^\s*(?>(?>Sun|Mon|Tue|Wed|Thu|Fri|Sat)\s*,\s*)?([0-9][0-9]?)\s*(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)\s*([0-9]{2,})/i) {
      $LastModified->{lc "$3$2"}++;
    } else {
      $LastModified->{$lm}++;
    }
  } else {
    $LastModified->{'(none)'}++;
  }

  if ($entity->{field}->{'content-type'}) {
    if (@{$entity->{field}->{'content-type'}} > 1) {
      $CT_duplicate++;
    }
    my $ct = $entity->{field}->{'content-type'}->[0];
    $ContentType->{$ct}++;
  } else {
    $ContentType->{'(none)'}++;
  }

  if ($entity->{field}->{'server'}) {
    if (@{$entity->{field}->{'server'}} > 1) {
      $Server_duplicate++;
    }
    my $server = $entity->{field}->{'server'}->[0];
    $server =~ s!/.*!!;
    $Server->{$server}++;
  } else {
    $Server->{'(none)'}++;
  }
};

require 'foreach.pl';

print "HTTP Version:\n";
for (sort {$a cmp $b} keys %{$Version}) {
  print $_, "\t", $Version->{$_}, "\n";
}
print "\n";

print "Server:\n";
for (sort {$a cmp $b} keys %$Server) {
  print $_, "\t", $Server->{$_}, "\n";
}
print "$Server_duplicate pages with Server duplication\n"
  if $Server_duplicate;
print "\n";

print "Last-Modified:\n";
for (sort {$a cmp $b} keys %$LastModified) {
  print $_, "\t", $LastModified->{$_}, "\n";
}
print "$LM_duplicate pages with Last-Modified duplication\n"
  if $LM_duplicate;
print "\n";

print "Content-Type:\n";
for (sort {$a cmp $b} keys %$ContentType) {
  print $_, "\t", $ContentType->{$_}, "\n";
}
print "$CT_duplicate pages with Content-Type duplication\n"
  if $CT_duplicate;
print "\n";

=head1 AUTHOR

Wakaba <w@suika.fam.cx>.

=head1 LICENSE

Copyright 2007 Wakaba <w@suika.fam.cx>

This library is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.

=cut

1;
## $Date:$

1	#!/usr/bin/perl
2	use strict;
3
4	use Encode::Guess;
5
6	my $Version = {};
7	my $LastModified = {};
8	my $LM_duplicate = 0;
9	my $ContentType = {};
10	my $CT_duplicate = 0;
11	my $Server = {};
12	my $Server_duplicate = 0;
13
14	our $target = shift;
15	our $code = sub {
16	my $entity = shift;
17	$Version->{$entity->{protocol_version}}++;
18
19	if ($entity->{field}->{'last-modified'}) {
20	if (@{$entity->{field}->{'last-modified'}} > 1) {
21	$LM_duplicate++;
22	}
23	my $lm = $entity->{field}->{'last-modified'}->[0];
24	if ($lm =~ /^\s(?>(?>Sun\|Mon\|Tue\|Wed\|Thu\|Fri\|Sat)\s,\s)?([0-9][0-9]?)\s(Jan\|Feb\|Mar\|Apr\|May\|Jun\|Jul\|Aug\|Sep\|Oct\|Nov\|Dec)\s*([0-9]{2,})/i) {
25	$LastModified->{lc "$3$2"}++;
26	} else {
27	$LastModified->{$lm}++;
28	}
29	} else {
30	$LastModified->{'(none)'}++;
31	}
32
33	if ($entity->{field}->{'content-type'}) {
34	if (@{$entity->{field}->{'content-type'}} > 1) {
35	$CT_duplicate++;
36	}
37	my $ct = $entity->{field}->{'content-type'}->[0];
38	$ContentType->{$ct}++;
39	} else {
40	$ContentType->{'(none)'}++;
41	}
42
43	if ($entity->{field}->{'server'}) {
44	if (@{$entity->{field}->{'server'}} > 1) {
45	$Server_duplicate++;
46	}
47	my $server = $entity->{field}->{'server'}->[0];
48	$server =~ s!/.*!!;
49	$Server->{$server}++;
50	} else {
51	$Server->{'(none)'}++;
52	}
53	};
54
55	require 'foreach.pl';
56
57	print "HTTP Version:\n";
58	for (sort {$a cmp $b} keys %{$Version}) {
59	print $_, "\t", $Version->{$_}, "\n";
60	}
61	print "\n";
62
63	print "Server:\n";
64	for (sort {$a cmp $b} keys %$Server) {
65	print $_, "\t", $Server->{$_}, "\n";
66	}
67	print "$Server_duplicate pages with Server duplication\n"
68	if $Server_duplicate;
69	print "\n";
70
71	print "Last-Modified:\n";
72	for (sort {$a cmp $b} keys %$LastModified) {
73	print $_, "\t", $LastModified->{$_}, "\n";
74	}
75	print "$LM_duplicate pages with Last-Modified duplication\n"
76	if $LM_duplicate;
77	print "\n";
78
79	print "Content-Type:\n";
80	for (sort {$a cmp $b} keys %$ContentType) {
81	print $_, "\t", $ContentType->{$_}, "\n";
82	}
83	print "$CT_duplicate pages with Content-Type duplication\n"
84	if $CT_duplicate;
85	print "\n";
86
87	=head1 AUTHOR
88
89	Wakaba <w@suika.fam.cx>.
90
91	=head1 LICENSE
92
93	Copyright 2007 Wakaba <w@suika.fam.cx>
94
95	This library is free software; you can redistribute it
96	and/or modify it under the same terms as Perl itself.
97
98	=cut
99
100	1;
101	## $Date:$
102